Cleaning up some build scripts and fixing compiler warnings.

This commit is contained in:
Joe Taylor 2021-04-22 13:12:55 -04:00
parent 8ce2291fd8
commit cfecb43d34
18 changed files with 20 additions and 418 deletions

View File

@ -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)

View File

@ -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

View File

@ -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)

View File

@ -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)

View File

@ -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

View File

@ -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/

View File

@ -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)

View File

@ -25,7 +25,6 @@ subroutine ftninit(appd)
character*(*) appd
character firstline*30
character addpfx*8
integer junk(256)
common/pfxcom/addpfx
addpfx=' '

View File

@ -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))

View File

@ -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))

View File

@ -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

View File

@ -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/

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -1,3 +1,4 @@
subroutine sleep_msec(n)
call usleep(n*1000)
return
end subroutine sleep_msec

View File

@ -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