mirror of
https://github.com/saitohirga/WSJT-X.git
synced 2024-11-22 04:11:16 -05:00
Cleaning up some build scripts and fixing compiler warnings.
This commit is contained in:
Joe Taylor
parent
8ce2291fd8
commit
cfecb43d34
@ -9,7 +9,6 @@ subroutine fast_decode(id2,narg,trperiod,line,mycall_12, &
|
||||
double precision trperiod
|
||||
real dat(30*12000)
|
||||
complex cdat(262145),cdat2(262145)
|
||||
real psavg(450)
|
||||
logical pick,first
|
||||
character*6 cfile6
|
||||
character*80 line(100)
|
||||
|
||||
@ -58,9 +58,6 @@ set (libm65_FSRCS
|
||||
packjt.f90
|
||||
pctile.f90
|
||||
pfxdump.f90
|
||||
qra64b.f90
|
||||
qra64c.f90
|
||||
qra64zap.f90
|
||||
recvpkt.f90
|
||||
rfile3a.f90
|
||||
s3avg.f90
|
||||
@ -70,7 +67,6 @@ set (libm65_FSRCS
|
||||
shell.f90
|
||||
sleep_msec.f90
|
||||
smo.f90
|
||||
spec64.f90
|
||||
sun.f90
|
||||
symspec.f90
|
||||
sync64.f90
|
||||
|
||||
@ -1,5 +1,4 @@
|
||||
subroutine afc65b(cx,cy,npts,fsample,nflip,ipol,xpol,ndphi,iloop, &
|
||||
a,ccfbest,dtbest)
|
||||
subroutine afc65b(cx,cy,npts,fsample,nflip,ipol,xpol,ndphi,a,ccfbest,dtbest)
|
||||
|
||||
logical xpol
|
||||
complex cx(npts)
|
||||
|
||||
@ -52,8 +52,8 @@ subroutine decode0(dd,ss,savg,nstandalone)
|
||||
|
||||
call timer('map65a ',0)
|
||||
call map65a(dd,ss,savg,newdat,nutc,fcenter,ntol,idphi,nfa,nfb, &
|
||||
mousedf,mousefqso,nagain,ndecdone,ndiskdat,nfshift,ndphi, &
|
||||
nfcal,nkeep,mcall3b,nsum,nsave,nxant,rmsdd,mycall,mygrid, &
|
||||
mousedf,mousefqso,nagain,ndecdone,nfshift,ndphi, &
|
||||
nfcal,nkeep,mcall3b,nsum,nsave,nxant,mycall,mygrid, &
|
||||
neme,ndepth,nstandalone,hiscall,hisgrid,nhsym,nfsample,nxpol,nmode)
|
||||
call timer('map65a ',1)
|
||||
call timer('decode0 ',1)
|
||||
|
||||
@ -1,6 +1,6 @@
|
||||
subroutine decode1a(dd,newdat,f0,nflip,mode65,nfsample,xpol, &
|
||||
mycall,hiscall,hisgrid,neme,ndepth,nqd,dphi,ndphi,iloop, &
|
||||
nutc,nkhz,ndf,ipol,ntol,bq65,sync2,a,dt,pol,nkv,nhist,nsum,nsave, &
|
||||
mycall,hiscall,hisgrid,neme,ndepth,nqd,dphi,ndphi, &
|
||||
nutc,nkhz,ndf,ipol,ntol,sync2,a,dt,pol,nkv,nhist,nsum,nsave, &
|
||||
qual,decoded)
|
||||
|
||||
! Apply AFC corrections to a candidate JT65 signal, then decode it.
|
||||
@ -14,7 +14,7 @@ subroutine decode1a(dd,newdat,f0,nflip,mode65,nfsample,xpol, &
|
||||
real s2(66,126)
|
||||
real s3(64,63),sy(63)
|
||||
real a(5)
|
||||
logical first,xpol,bq65
|
||||
logical first,xpol
|
||||
character decoded*22
|
||||
character mycall*12,hiscall*12,hisgrid*6
|
||||
data first/.true./,jjjmin/1000/,jjjmax/-1000/
|
||||
@ -68,8 +68,7 @@ subroutine decode1a(dd,newdat,f0,nflip,mode65,nfsample,xpol, &
|
||||
! factor of 1/8, say? Should be a significant execution speed-up.
|
||||
call timer('afc65b ',0)
|
||||
! Best fit for DF, f1, f2, pol
|
||||
call afc65b(c5x(i0),c5y(i0),nz,fsample,nflip,ipol,xpol, &
|
||||
ndphi,iloop,a,ccfbest,dtbest)
|
||||
call afc65b(c5x(i0),c5y(i0),nz,fsample,nflip,ipol,xpol,ndphi,a,ccfbest,dtbest)
|
||||
call timer('afc65b ',1)
|
||||
|
||||
pol=a(4)/57.2957795
|
||||
|
||||
@ -5,7 +5,7 @@ real function dpol(mygrid,hisgrid)
|
||||
|
||||
character*6 MyGrid,HisGrid
|
||||
real lat,lon,LST
|
||||
character cdate*8,ctime2*10,czone*5,fnamedate*6
|
||||
character cdate*8,ctime2*10,czone*5
|
||||
integer it(8)
|
||||
data rad/57.2957795/
|
||||
|
||||
|
||||
@ -13,7 +13,7 @@ subroutine fil6521(c1,n1,c2,n2)
|
||||
! fout (Hz) 344.531 Output sample rate
|
||||
|
||||
parameter (NTAPS=21)
|
||||
parameter (NH=NTAPS/2)
|
||||
parameter (NH=(NTAPS-1)/2)
|
||||
parameter (NDOWN=4) !Downsample ratio = 1/4
|
||||
complex c1(n1)
|
||||
complex c2(n1/NDOWN)
|
||||
|
||||
@ -25,7 +25,6 @@ subroutine ftninit(appd)
|
||||
character*(*) appd
|
||||
character firstline*30
|
||||
character addpfx*8
|
||||
integer junk(256)
|
||||
common/pfxcom/addpfx
|
||||
|
||||
addpfx=' '
|
||||
|
||||
@ -69,7 +69,7 @@ subroutine getpfx1(callsign,k,nv2)
|
||||
k=-1
|
||||
else
|
||||
if(ispfx) then
|
||||
tpfx=lof
|
||||
tpfx=lof(1:4)
|
||||
k=nchar(tpfx(1:1))
|
||||
k=37*k + nchar(tpfx(2:2))
|
||||
k=37*k + nchar(tpfx(3:3))
|
||||
@ -80,7 +80,7 @@ subroutine getpfx1(callsign,k,nv2)
|
||||
callsign=callsign0(i+1:)
|
||||
endif
|
||||
if(issfx) then
|
||||
tsfx=rof
|
||||
tsfx=rof(1:3)
|
||||
k=nchar(tsfx(1:1))
|
||||
k=37*k + nchar(tsfx(2:2))
|
||||
k=37*k + nchar(tsfx(3:3))
|
||||
|
||||
@ -2,7 +2,6 @@ subroutine iqfix(c,nfft,gain,phase)
|
||||
|
||||
complex c(0:nfft-1)
|
||||
complex z,h,u,v
|
||||
real*8 sq1,sq2
|
||||
|
||||
nh=nfft/2
|
||||
h=gain*cmplx(cos(phase),sin(phase))
|
||||
|
||||
@ -1,6 +1,6 @@
|
||||
subroutine map65a(dd,ss,savg,newdat,nutc,fcenter,ntol,idphi,nfa,nfb, &
|
||||
mousedf,mousefqso,nagain,ndecdone,ndiskdat,nfshift,ndphi, &
|
||||
nfcal,nkeep,mcall3b,nsum,nsave,nxant,rmsdd,mycall,mygrid, &
|
||||
mousedf,mousefqso,nagain,ndecdone,nfshift,ndphi, &
|
||||
nfcal,nkeep,mcall3b,nsum,nsave,nxant,mycall,mygrid, &
|
||||
neme,ndepth,nstandalone,hiscall,hisgrid,nhsym,nfsample,nxpol,nmode)
|
||||
|
||||
! Processes timf2 data from Linrad to find and decode JT65 signals.
|
||||
@ -101,7 +101,7 @@ subroutine map65a(dd,ss,savg,newdat,nutc,fcenter,ntol,idphi,nfa,nfb, &
|
||||
if(iii.ge.1 .and. iii.le.32768) then
|
||||
tavg(ii)=savg(jp,iii)
|
||||
else
|
||||
write(13,*) ,'Error in iii:',iii,ia,ib,fa,fb
|
||||
write(13,*) 'Error in iii:',iii,ia,ib,fa,fb
|
||||
flush(13)
|
||||
go to 999
|
||||
endif
|
||||
@ -221,7 +221,7 @@ subroutine map65a(dd,ss,savg,newdat,nutc,fcenter,ntol,idphi,nfa,nfb, &
|
||||
idf=nint(1000.0*(freq+0.5*(nfa+nfb)-foffset-(ikHz+nfshift)))
|
||||
call decode1a(dd,newdat,f00,nflip,mode65,nfsample, &
|
||||
xpol,mycall,hiscall,hisgrid,neme,ndepth,nqd,dphi, &
|
||||
ndphi,iloop,nutc,ikHz,idf,ipol,ntol,bq65,sync2, &
|
||||
ndphi,nutc,ikHz,idf,ipol,ntol,sync2, &
|
||||
a,dt,pol,nkv,nhist,nsum,nsave,qual,decoded)
|
||||
call timer('decode1a',1)
|
||||
if(nqd.eq.2) then
|
||||
@ -319,7 +319,7 @@ subroutine map65a(dd,ss,savg,newdat,nutc,fcenter,ntol,idphi,nfa,nfb, &
|
||||
if(ntxpol.gt.45 .and. ntxpol.le.135) cp='V'
|
||||
else
|
||||
cp='/'
|
||||
if(ntxpol.ge.90 .and. ntxpol.lt.180) cp='\\'
|
||||
if(ntxpol.ge.90 .and. ntxpol.lt.180) cp='\'
|
||||
endif
|
||||
endif
|
||||
endif
|
||||
@ -446,7 +446,7 @@ subroutine map65a(dd,ss,savg,newdat,nutc,fcenter,ntol,idphi,nfa,nfb, &
|
||||
if(ntxpol.gt.45 .and. ntxpol.le.135) cp='V'
|
||||
else
|
||||
cp='/'
|
||||
if(ntxpol.ge.90 .and. ntxpol.lt.180) cp='\\'
|
||||
if(ntxpol.ge.90 .and. ntxpol.lt.180) cp='\'
|
||||
endif
|
||||
endif
|
||||
endif
|
||||
|
||||
@ -18,9 +18,8 @@ subroutine MoonDop(nyear,month,nday,uth4,lon4,lat4,RAMoon4,DecMoon4, &
|
||||
real*8 RME(6) !Vector from Earth center to Moon
|
||||
real*8 RAE(6) !Vector from Earth center to Obs
|
||||
real*8 RMA(6) !Vector from Obs to Moon
|
||||
real*8 pvsun(6)
|
||||
real*8 rme0(6)
|
||||
logical km,bary
|
||||
logical km
|
||||
|
||||
data rad/57.2957795130823d0/,twopi/6.28310530717959d0/
|
||||
|
||||
|
||||
@ -1,65 +0,0 @@
|
||||
subroutine qra64b(nutc,nqd,fcenter,nfcal,nfsample,ikhz,mousedf,ntol,xpol, &
|
||||
mycall_12,hiscall_12,hisgrid_6,mode64,nwrite_qra64)
|
||||
|
||||
parameter (MAXFFT1=5376000) !56*96000
|
||||
parameter (MAXFFT2=336000) !56*6000 (downsampled by 1/16)
|
||||
complex ca(MAXFFT1),cb(MAXFFT1) !FFTs of raw x,y data
|
||||
complex cx(0:MAXFFT2-1),cy(0:MAXFFT2-1)
|
||||
logical xpol
|
||||
real*8 fcenter
|
||||
character*12 mycall_12,hiscall_12
|
||||
character*6 hisgrid_6
|
||||
common/cacb/ca,cb
|
||||
data nzap/3/
|
||||
|
||||
open(17,file='red.dat',status='unknown')
|
||||
|
||||
nfft1=MAXFFT1
|
||||
nfft2=MAXFFT2
|
||||
df=96000.0/NFFT1
|
||||
if(nfsample.eq.95238) then
|
||||
nfft1=5120000
|
||||
nfft2=322560
|
||||
df=96000.0/nfft1
|
||||
endif
|
||||
nh=nfft2/2
|
||||
ikhz0=nint(1000.0*(fcenter-int(fcenter)))
|
||||
k0=((ikhz-ikhz0+48.0+1.27)*1000.0+nfcal)/df
|
||||
if(k0.lt.nh .or. k0.gt.nfft1-nh) go to 900
|
||||
|
||||
fac=1.0/nfft2
|
||||
cx(0:nh)=ca(k0:k0+nh)
|
||||
cx(nh+1:nfft2-1)=ca(k0-nh+1:k0-1)
|
||||
cx=fac*cx
|
||||
if(xpol) then
|
||||
cy(0:nh)=cb(k0:k0+nh)
|
||||
cy(nh+1:nfft2-1)=cb(k0-nh+1:k0-1)
|
||||
cy=fac*cy
|
||||
endif
|
||||
|
||||
! Here cx and cy (if xpol) are frequency-domain data around the selected
|
||||
! QSO frequency, taken from the full-length FFT computed in filbig().
|
||||
! Values for fsample, nfft1, nfft2, df, and the downsampled data rate
|
||||
! are as follows:
|
||||
|
||||
! fSample nfft1 df nfft2 fDownSampled
|
||||
! (Hz) (Hz) (Hz)
|
||||
!----------------------------------------------------
|
||||
! 96000 5376000 0.017857143 336000 6000.000
|
||||
! 95238 5120000 0.018601172 322560 5999.994
|
||||
|
||||
! write(60) cx,cy,nutc,nqd,ikhz,mousedf,ntol,xpol,mycall_12, &
|
||||
! hiscall_12,hisgrid_6
|
||||
|
||||
if(nzap.gt.0) call qra64zap(cx,cy,xpol,nzap)
|
||||
|
||||
! Transform back to time domain with sample rate 6000 Hz.
|
||||
call four2a(cx,nfft2,1,-1,1)
|
||||
call four2a(cy,nfft2,1,-1,1)
|
||||
|
||||
call qra64c(cx,cy,nutc,nqd,ikhz,mousedf,ntol,xpol,mycall_12, &
|
||||
hiscall_12,hisgrid_6,mode64,nwrite_qra64)
|
||||
close(17)
|
||||
|
||||
900 return
|
||||
end subroutine qra64b
|
||||
@ -1,221 +0,0 @@
|
||||
subroutine qra64c(cx,cy,nutc,nqd,ikhz,nfqso,ntol,xpol,mycall_12, &
|
||||
hiscall_12,hisgrid_6,mode64,nwrite_qra64)
|
||||
|
||||
use packjt
|
||||
parameter (NFFT2=336000) !56*6000 (downsampled by 1/16)
|
||||
parameter (NMAX=60*12000,LN=1152*63)
|
||||
|
||||
character decoded*22
|
||||
character*12 mycall_12,hiscall_12
|
||||
character*6 mycall,hiscall,hisgrid_6,grid
|
||||
character*4 hisgrid
|
||||
character cp*1,cmode*2
|
||||
logical xpol,ltext
|
||||
complex cx(0:NFFT2-1),cy(0:NFFT2-1)
|
||||
complex c00(0:720000) !Complex spectrum of dd()
|
||||
complex c0(0:720000) !Complex data for dd()
|
||||
real a(3)
|
||||
real s3(LN) !Symbol spectra
|
||||
real s3a(LN) !Symbol spectra
|
||||
integer dat4(12) !Decoded message (as 12 integers)
|
||||
integer dat4x(12)
|
||||
integer nap(0:11)
|
||||
data nap/0,2,3,2,3,4,2,3,6,4,6,6/,cmode/'$'/
|
||||
data nc1z/-1/,nc2z/-1/,ng2z/-1/,maxaptypez/-1/
|
||||
save
|
||||
|
||||
! For now:
|
||||
nf1=-3000
|
||||
nf2=3000
|
||||
! mode64=1
|
||||
minsync=-1
|
||||
ndepth=3
|
||||
emedelay=2.5
|
||||
|
||||
irc=-1
|
||||
nwrite_qra64=0
|
||||
decoded=' '
|
||||
nft=99
|
||||
mycall=mycall_12(1:6)
|
||||
hiscall=hiscall_12(1:6)
|
||||
hisgrid=hisgrid_6(1:4)
|
||||
call packcall(mycall,nc1,ltext)
|
||||
call packcall(hiscall,nc2,ltext)
|
||||
call packgrid(hisgrid,ng2,ltext)
|
||||
nSubmode=0
|
||||
if(mode64.eq.2) nSubmode=1
|
||||
if(mode64.eq.4) nSubmode=2
|
||||
if(mode64.eq.8) nSubmode=3
|
||||
if(mode64.eq.16) nSubmode=4
|
||||
cmode(2:2)=char(ichar('A')+nSubmode)
|
||||
b90=1.0
|
||||
nFadingModel=1
|
||||
maxaptype=4
|
||||
if(iand(ndepth,64).ne.0) maxaptype=5
|
||||
if(nc1.ne.nc1z .or. nc2.ne.nc2z .or. ng2.ne.ng2z .or. &
|
||||
maxaptype.ne.maxaptypez) then
|
||||
do naptype=0,maxaptype
|
||||
if(naptype.eq.2 .and. maxaptype.eq.4) cycle
|
||||
call qra64_dec(s3,nc1,nc2,ng2,naptype,1,nSubmode,b90, &
|
||||
nFadingModel,dat4,snr2,irc)
|
||||
enddo
|
||||
nc1z=nc1
|
||||
nc2z=nc2
|
||||
ng2z=ng2
|
||||
maxaptypez=maxaptype
|
||||
endif
|
||||
naptype=maxaptype
|
||||
npts2=NFFT2
|
||||
|
||||
ipz=0
|
||||
if(xpol) ipz=3
|
||||
do ip=0,ipz
|
||||
if(ip.eq.0) c00(0:NFFT2-1)=conjg(cx)
|
||||
if(ip.eq.1) c00(0:NFFT2-1)=0.707*conjg(cx+cy)
|
||||
if(ip.eq.2) c00(0:NFFT2-1)=conjg(cy)
|
||||
if(ip.eq.3) c00(0:NFFT2-1)=0.707*conjg(cx-cy)
|
||||
|
||||
call sync64(c00,nf1,nf2,nfqso,ntol,mode64,emedelay,dtx,f0,jpk0,sync, &
|
||||
sync2,width)
|
||||
|
||||
nfreq=nint(f0)
|
||||
if(mode64.eq.1 .and. minsync.ge.0 .and. (sync-7.0).lt.minsync) go to 900
|
||||
a=0.
|
||||
a(1)=-f0
|
||||
call twkfreq(c00,c0,npts2,6000.0,a)
|
||||
|
||||
irc=-99
|
||||
s3lim=20.
|
||||
itryz=5
|
||||
itz=11
|
||||
if(mode64.eq.4) itz=9
|
||||
if(mode64.eq.2) itz=7
|
||||
if(mode64.eq.1) itz=5
|
||||
|
||||
if(mode64.eq.1) then
|
||||
itz=0
|
||||
itryz=1
|
||||
endif
|
||||
|
||||
LL=64*(mode64+2)
|
||||
NN=63
|
||||
napmin=99
|
||||
do itry0=1,itryz
|
||||
idt=itry0/2
|
||||
if(mod(itry0,2).eq.0) idt=-idt
|
||||
jpk=jpk0 + 750*idt
|
||||
call spec64(c0,npts2,mode64,jpk,s3a,LL,NN)
|
||||
call pctile(s3a,LL*NN,40,base)
|
||||
s3a=s3a/base
|
||||
where(s3a(1:LL*NN)>s3lim) s3a(1:LL*NN)=s3lim
|
||||
do iter=itz,0,-2
|
||||
b90=1.728**iter
|
||||
if(b90.gt.230.0) cycle
|
||||
if(b90.lt.0.15*width) exit
|
||||
s3(1:LL*NN)=s3a(1:LL*NN)
|
||||
call timer('qra64_de',0)
|
||||
call qra64_dec(s3,nc1,nc2,ng2,naptype,0,nSubmode,b90, &
|
||||
nFadingModel,dat4,snr2,irc)
|
||||
call timer('qra64_de',1)
|
||||
if(irc.eq.0) go to 10
|
||||
if(irc.gt.0) call badmsg(irc,dat4,nc1,nc2,ng2)
|
||||
iirc=max(0,min(irc,11))
|
||||
if(irc.gt.0 .and. nap(iirc).lt.napmin) then
|
||||
dat4x=dat4
|
||||
b90x=b90
|
||||
snr2x=snr2
|
||||
napmin=nap(iirc)
|
||||
irckeep=irc
|
||||
dtxkeep=jpk/6000.0 - 1.0
|
||||
itry0keep=itry0
|
||||
iterkeep=iter
|
||||
npolkeep=ip*45
|
||||
endif
|
||||
enddo
|
||||
if(irc.eq.0) goto 5
|
||||
enddo
|
||||
enddo
|
||||
|
||||
5 if(napmin.ne.99) then
|
||||
dat4=dat4x
|
||||
b90=b90x
|
||||
snr2=snr2x
|
||||
irc=irckeep
|
||||
dtx=dtxkeep
|
||||
itry0=itry0keep
|
||||
iter=iterkeep
|
||||
npol=npolkeep
|
||||
endif
|
||||
10 decoded=' '
|
||||
|
||||
if(irc.ge.0) then
|
||||
if(irc.eq.0) npol=ip*45
|
||||
call unpackmsg(dat4,decoded) !Unpack the user message
|
||||
call fmtmsg(decoded,iz)
|
||||
if(index(decoded,"000AAA ").ge.1) then
|
||||
! Suppress a certain type of garbage decode.
|
||||
decoded=' '
|
||||
irc=-1
|
||||
endif
|
||||
nft=100 + irc
|
||||
nsnr=nint(snr2)
|
||||
else
|
||||
snr2=0.
|
||||
endif
|
||||
|
||||
900 if(irc.lt.0) then
|
||||
sy=max(1.0,sync)
|
||||
if(nSubmode.eq.0) nsnr=nint(10.0*log10(sy)-35.0) !A
|
||||
if(nSubmode.eq.1) nsnr=nint(10.0*log10(sy)-34.0) !B
|
||||
if(nSubmode.eq.2) nsnr=nint(10.0*log10(sy)-29.0) !C
|
||||
if(nSubmode.eq.3) nsnr=nint(10.0*log10(sy)-29.0) !D
|
||||
if(nSubmode.eq.4) nsnr=nint(10.0*log10(sy)-24.0) !E
|
||||
endif
|
||||
|
||||
! If Tx station's grid is in decoded message, compute optimum TxPol
|
||||
i1=index(decoded,' ')
|
||||
i2=index(decoded(i1+1:),' ') + i1
|
||||
grid=' '
|
||||
if(i2.ge.8 .and. i2.le.18) grid=decoded(i2+1:i2+4)//'mm'
|
||||
ntxpol=0
|
||||
cp=' '
|
||||
if(xpol) then
|
||||
if(grid(1:1).ge.'A' .and. grid(1:1).le.'R' .and. &
|
||||
grid(2:2).ge.'A' .and. grid(2:2).le.'R' .and. &
|
||||
grid(3:3).ge.'0' .and. grid(3:3).le.'9' .and. &
|
||||
grid(4:4).ge.'0' .and. grid(4:4).le.'9') then
|
||||
ntxpol=mod(npol-nint(2.0*dpol(mygrid,grid))+720,180)
|
||||
if(nxant.eq.0) then
|
||||
cp='H'
|
||||
if(ntxpol.gt.45 .and. ntxpol.le.135) cp='V'
|
||||
else
|
||||
cp='/'
|
||||
if(ntxpol.ge.90 .and. ntxpol.lt.180) cp='\\'
|
||||
endif
|
||||
endif
|
||||
endif
|
||||
|
||||
if(irc.ge.0) then
|
||||
write(*,1010) ikHz,nfreq,npol,nutc,dtx,nsnr,cmode(1:1),decoded, &
|
||||
irc,ntxpol,cp
|
||||
1010 format('!',i3,i5,i4,i6.4,f5.1,i5,1x,a1,1x,a22,i2,5x,i5,1x,a1)
|
||||
nwrite_qra64=nwrite_qra64+1
|
||||
freq=144.0 + 0.001*ikhz
|
||||
write(21,1014) freq,nfreq,dtx,npol,nsnr,nutc,decoded,cp, &
|
||||
cmode(1:1),cmode(2:2)
|
||||
1014 format(f8.3,i5,f5.1,2i4,i5.4,2x,a22,2x,a1,3x,a1,1x,a1)
|
||||
|
||||
if(index(decoded,'CQ ').gt.0 .or. index(decoded,'QRZ ').gt.0 .or. &
|
||||
index(decoded,'QRT ').gt.0 .or. index(decoded,'CQV ').gt.0 .or. &
|
||||
index(decoded,'CQH ').gt.0) then
|
||||
write(19,1016) ikhz,nfreq,npol,nutc,dtx,nsnr,decoded,0,cmode
|
||||
1016 format(i3,i5,i4,i5.4,f7.1,i4,2x,a22,i3,1x,a2)
|
||||
flush(19)
|
||||
endif
|
||||
else
|
||||
write(*,1010) ikHz,nfreq,npol,nutc,dtx,nsnr
|
||||
nwrite_qra64=nwrite_qra64+1
|
||||
endif
|
||||
|
||||
return
|
||||
end subroutine qra64c
|
||||
@ -1,62 +0,0 @@
|
||||
subroutine qra64zap(cx,cy,xpol,nzap)
|
||||
|
||||
parameter (NFFT1=5376000) !56*96000
|
||||
parameter (NFFT2=336000) !56*6000 (downsampled by 1/16)
|
||||
complex cx(0:NFFT2-1),cy(0:NFFT2-1)
|
||||
real s(-1312:1312)
|
||||
integer iloc(1)
|
||||
logical xpol
|
||||
|
||||
slimit=3.0
|
||||
sbottom=1.5
|
||||
nadd=128
|
||||
nblks=NFFT2/nadd
|
||||
nbh=nblks/2
|
||||
k=-1
|
||||
s=0.
|
||||
df=nadd*96000.0/NFFT1
|
||||
do i=1,nblks
|
||||
j=i
|
||||
if(j.gt.nblks/2) j=j-nblks
|
||||
do n=1,nadd
|
||||
k=k+1
|
||||
s(j)=s(j) + real(cx(k))**2 + aimag(cx(k))**2
|
||||
if(xpol) s(j)=s(j) + real(cy(k))**2 + aimag(cy(k))**2
|
||||
enddo
|
||||
enddo
|
||||
call pctile(s,nblks,45,base)
|
||||
s=s/base
|
||||
do nzap=1,3
|
||||
iloc=maxloc(s)
|
||||
ipk=iloc(1)-1313
|
||||
smax=s(ipk)
|
||||
nw=3
|
||||
do n=1,3
|
||||
nw=2*nw
|
||||
if(ipk-2*nw.lt.-1312) cycle
|
||||
if(ipk+2*nw.gt. 1312) cycle
|
||||
s1=maxval(s(ipk-2*nw:ipk-nw))
|
||||
s2=maxval(s(ipk+nw:ipk+2*nw))
|
||||
if(smax.gt.slimit .and. s1.lt.sbottom .and. s2.lt.sbottom) then
|
||||
s(ipk-nw:ipk+nw)=1.0
|
||||
i0=ipk
|
||||
if(i0.lt.0) i0=i0+2625
|
||||
ia=(i0-nw)*nadd
|
||||
ib=(i0+nw)*nadd
|
||||
cx(ia:ib)=0.
|
||||
cy(ia:ib)=0.
|
||||
exit
|
||||
endif
|
||||
enddo
|
||||
enddo
|
||||
|
||||
! rewind 75
|
||||
! do i=-nbh,nbh
|
||||
! freq=i*df
|
||||
! write(75,3001) freq,s(i)
|
||||
!3001 format(2f12.3)
|
||||
! enddo
|
||||
! flush(75)
|
||||
|
||||
return
|
||||
end subroutine qra64zap
|
||||
@ -16,6 +16,7 @@ subroutine recvpkt(nsam,nblock2,userx_no,k,buf4,buf8,buf16)
|
||||
equivalence (jd,d8,yd)
|
||||
equivalence (xd,c16)
|
||||
|
||||
if(nblock2.eq.-9999) nblock2=-9998 !Silence a compiler warning
|
||||
if(nsam.eq.-1) then
|
||||
! Move data from the UDP packet buffer into array dd().
|
||||
if(userx_no.eq.-1) then
|
||||
|
||||
@ -1,3 +1,4 @@
|
||||
subroutine sleep_msec(n)
|
||||
call usleep(n*1000)
|
||||
return
|
||||
end subroutine sleep_msec
|
||||
|
||||
@ -1,42 +0,0 @@
|
||||
subroutine spec64(c0,npts2,mode64,jpk,s3,LL,NN)
|
||||
|
||||
parameter (NSPS=3456) !Samples per symbol at 6000 Hz
|
||||
complex c0(0:360000) !Complex spectrum of dd()
|
||||
complex cs(0:NSPS-1) !Complex symbol spectrum
|
||||
real s3(LL,NN) !Synchronized symbol spectra
|
||||
real xbase0(LL),xbase(LL)
|
||||
|
||||
nfft=nsps
|
||||
fac=1.0/nfft
|
||||
do j=1,NN
|
||||
jj=j+7 !Skip first Costas array
|
||||
if(j.ge.33) jj=j+14 !Skip middle Costas array
|
||||
ja=jpk + (jj-1)*nfft
|
||||
jb=ja+nfft-1
|
||||
cs(0:nfft-1)=fac*c0(ja:jb)
|
||||
call four2a(cs,nfft,1,-1,1)
|
||||
do ii=1,LL
|
||||
i=ii-65
|
||||
if(i.lt.0) i=i+nfft
|
||||
s3(ii,j)=real(cs(i))**2 + aimag(cs(i))**2
|
||||
enddo
|
||||
enddo
|
||||
|
||||
df=6000.0/nfft
|
||||
do i=1,LL
|
||||
call pctile(s3(i,1:NN),NN,45,xbase0(i)) !Get baseline for passband shape
|
||||
enddo
|
||||
|
||||
nh=25
|
||||
xbase(1:nh-1)=sum(xbase0(1:nh-1))/(nh-1.0)
|
||||
xbase(LL-nh+1:LL)=sum(xbase0(LL-nh+1:LL))/(nh-1.0)
|
||||
do i=nh,LL-nh
|
||||
xbase(i)=sum(xbase0(i-nh+1:i+nh))/(2*nh+1) !Smoothed passband shape
|
||||
enddo
|
||||
|
||||
do i=1,LL
|
||||
s3(i,1:NN)=s3(i,1:NN)/(xbase(i)+0.001) !Apply frequency equalization
|
||||
enddo
|
||||
|
||||
return
|
||||
end subroutine spec64
|
||||
Loading…
Reference in New Issue
Block a user