w4kek/WSJT-X
1
0
Fork 0
mirror of https://github.com/saitohirga/WSJT-X.git synced 2025-09-02 13:17:49 -04:00
Code Issues Packages Projects Releases Wiki Activity

- Set prop svn:eol-style native on files.

Browse Source 
- Remove alsa/oss from configure.ac and regenerate configure file.
- Note it is MAP65 not WSJT.
- rfile3a.f90 -> rfile3a.F90 for gfortran preprocessor.
- Comment out compiler option that does not work on gfortran for now.



git-svn-id: svn+ssh://svn.code.sf.net/p/wsjt/wsjt/branches/map65@1151 ab8295b8-cf94-4d9e-aec4-7959e3be5d79
This commit is contained in:
Diane Bruce 2009-04-23 19:02:43 +00:00
parent c750d4d6ee
commit eaa540b65b
37 changed files with 7315 additions and 6598 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
Makefile.in
View File

@ -4,17 +4,21 @@ LDFLAGS = @LDFLAGS@
LIBS = @LIBS@ LIBS = @LIBS@
CPPFLAGS = @CPPFLAGS@ CPPFLAGS = @CPPFLAGS@
CFLAGS = @CFLAGS@ CFLAGS = @CFLAGS@
# WSJT specific C flags # Map65 specific C flags
CFLAGS += -DBIGSYM=1 -fPIC CFLAGS += -DBIGSYM=1 -fPIC
DEFS = @DEFS@ DEFS = @DEFS@
CFLAGS += ${DEFS} CFLAGS += ${DEFS}
CPPFLAGS += ${DEFS} -I. CPPFLAGS += ${DEFS} -I.
# WSJT specific Fortran flags # MAP65 specific Fortran flags
FFLAGS += -Wall -Wno-precision-loss -fbounds-check -fno-second-underscore -fPIC # gfortran has no -Wno-precission-loss
FFLAGS += -Wall -fbounds-check -fno-second-underscore -fPIC#FFLAGS += -Wall -Wno-precision-loss -fbounds-check -fno-second-underscore -fPIC
#FFLAGS += -Wall -fbounds-check -fno-second-underscore -ffixed-line-length-none -fPIC #FFLAGS += -Wall -fbounds-check -fno-second-underscore -ffixed-line-length-none -fPIC
#FFLAGS += -Wall -fbounds-check -fno-second-underscore -fPIC #FFLAGS += -Wall -fbounds-check -fno-second-underscore -fPIC
#FFLAGS += -cpp -fno-second-underscore #FFLAGS += -cpp -fno-second-underscore
all: Audio.so plrs plrr
# The default rules # The default rules
.c.o: .c.o:
${CC} ${CPPFLAGS} ${CFLAGS} -c -o ${<:.c=.o} $< ${CC} ${CPPFLAGS} ${CFLAGS} -c -o ${<:.c=.o} $<
@ -30,14 +34,14 @@ FC=@FC@
COMPILER += @FC_LIB_PATH@ COMPILER += @FC_LIB_PATH@
LDFLAGS += -L${COMPILER} LDFLAGS += -L${COMPILER}
LIBS += /usr/lib/libfftw3f.a
PYTHON ?= @PYTHON@ PYTHON ?= @PYTHON@
RM ?= @RM@ RM ?= @RM@
F2PY = @F2PY@ F2PY = @F2PY@
### ###
all: Audio.so plrs plrr
OBJS2C = init_rs.o encode_rs.o decode_rs.o plrr_subs.o loc.o deep65.o OBJS2C = init_rs.o encode_rs.o decode_rs.o plrr_subs.o loc.o deep65.o
@ -71,19 +75,6 @@ SRCS3C = ptt_unix.c igray.c wrapkarn.c cutil.c
OBJS3C = ${SRCS3C:.c=.o} OBJS3C = ${SRCS3C:.c=.o}
AUDIOSRCS = a2d.f90 jtaudio.c start_portaudio.c AUDIOSRCS = a2d.f90 jtaudio.c start_portaudio.c
#Audio.so: $(OBJS2C) $(SRCS2F90) $(SRCS2F77) $(SRCS2C)
# python f2py.py -c \
# --quiet --"fcompiler=compaqv" \
# --opt="/nologo /traceback /warn:errors /fast /fpp /define:Win32 \
# /define:USE_PORTAUDIO" \
# $(OBJS2C) \
# -lwinmm -lpa -lfftw3single -llibsamplerate \
# -m Audio \
# only: $(F2PYONLY) : \
# $(SRCS2F90) $(SRCS2F77) $(SRCS2C)
###
deep65.o: deep65.F deep65.o: deep65.F
$(FC) -c -O0 -Wall -fPIC deep65.F $(FC) -c -O0 -Wall -fPIC deep65.F

68
a2d.f90
View File

@ -1,34 +1,34 @@
!---------------------------------------------------- a2d !---------------------------------------------------- a2d
subroutine a2d(iarg) subroutine a2d(iarg)
! Start the PortAudio streams for audio input and output. ! Start the PortAudio streams for audio input and output.
integer nchin(0:20),nchout(0:20) integer nchin(0:20),nchout(0:20)
include 'gcom1.f90' include 'gcom1.f90'
include 'gcom2.f90' include 'gcom2.f90'
! This call does not normally return, as the background portion of ! This call does not normally return, as the background portion of
! JTaudio goes into a test-and-sleep loop. ! JTaudio goes into a test-and-sleep loop.
write(*,1000) write(*,1000)
1000 format('Using Linrad for input, PortAudio for output.') 1000 format('Using Linrad for input, PortAudio for output.')
idevout=ndevout idevout=ndevout
call padevsub(numdevs,ndefin,ndefout,nchin,nchout) call padevsub(numdevs,ndefin,ndefout,nchin,nchout)
write(*,1002) ndefout write(*,1002) ndefout
1002 format(/'Default Output:',i3) 1002 format(/'Default Output:',i3)
write(*,1004) idevout write(*,1004) idevout
1004 format('Requested Output:',i3) 1004 format('Requested Output:',i3)
if(idevout.lt.0 .or. idevout.ge.numdevs) idevout=ndefout if(idevout.lt.0 .or. idevout.ge.numdevs) idevout=ndefout
if(idevout.eq.0) idevout=ndefout if(idevout.eq.0) idevout=ndefout
idevin=0 idevin=0
ierr=jtaudio(idevin,idevout,y1,y2,NMAX,iwrite,iwave,nwave, & ierr=jtaudio(idevin,idevout,y1,y2,NMAX,iwrite,iwave,nwave, &
11025,NSPB,TRPeriod,TxOK,ndebug,Transmitting, & 11025,NSPB,TRPeriod,TxOK,ndebug,Transmitting, &
Tsec,ngo,nmode,tbuf,ibuf,ndsec) Tsec,ngo,nmode,tbuf,ibuf,ndsec)
if(ierr.ne.0) then if(ierr.ne.0) then
print*,'Error ',ierr,' in JTaudio, cannot continue.' print*,'Error ',ierr,' in JTaudio, cannot continue.'
else else
write(*,1006) write(*,1006)
1006 format('Audio output stream terminated normally.') 1006 format('Audio output stream terminated normally.')
endif endif
return return
end subroutine a2d end subroutine a2d

238
astro0.F90
View File

@ -1,119 +1,119 @@
!--------------------------------------------------- astro0 !--------------------------------------------------- astro0
subroutine astro0(nyear,month,nday,uth8,nfreq,grid,cauxra,cauxdec, & subroutine astro0(nyear,month,nday,uth8,nfreq,grid,cauxra,cauxdec, &
AzSun8,ElSun8,AzMoon8,ElMoon8,AzMoonB8,ElMoonB8,ntsky,ndop,ndop00, & AzSun8,ElSun8,AzMoon8,ElMoon8,AzMoonB8,ElMoonB8,ntsky,ndop,ndop00, &
dbMoon8,RAMoon8,DecMoon8,HA8,Dgrd8,sd8,poloffset8,xnr8,dfdt,dfdt0, & dbMoon8,RAMoon8,DecMoon8,HA8,Dgrd8,sd8,poloffset8,xnr8,dfdt,dfdt0, &
RaAux8,DecAux8,AzAux8,ElAux8) RaAux8,DecAux8,AzAux8,ElAux8)
!f2py intent(in) nyear,month,nday,uth8,nfreq,grid,cauxra,cauxdec !f2py intent(in) nyear,month,nday,uth8,nfreq,grid,cauxra,cauxdec
!f2py intent(out) AzSun8,ElSun8,AzMoon8,ElMoon8,AzMoonB8,ElMoonB8,ntsky,ndop,ndop00,dbMoon8,RAMoon8,DecMoon8,HA8,Dgrd8,sd8,poloffset8,xnr8,dfdt,dfdt0,RaAux8,DecAux8,AzAux8,ElAux8 !f2py intent(out) AzSun8,ElSun8,AzMoon8,ElMoon8,AzMoonB8,ElMoonB8,ntsky,ndop,ndop00,dbMoon8,RAMoon8,DecMoon8,HA8,Dgrd8,sd8,poloffset8,xnr8,dfdt,dfdt0,RaAux8,DecAux8,AzAux8,ElAux8
character grid*6 character grid*6
character*9 cauxra,cauxdec character*9 cauxra,cauxdec
real*8 AzSun8,ElSun8,AzMoon8,ElMoon8,AzMoonB8,ElMoonB8,AzAux8,ElAux8 real*8 AzSun8,ElSun8,AzMoon8,ElMoon8,AzMoonB8,ElMoonB8,AzAux8,ElAux8
real*8 dbMoon8,RAMoon8,DecMoon8,HA8,Dgrd8,xnr8,dfdt,dfdt0 real*8 dbMoon8,RAMoon8,DecMoon8,HA8,Dgrd8,xnr8,dfdt,dfdt0
real*8 sd8,poloffset8 real*8 sd8,poloffset8
include 'gcom2.f90' include 'gcom2.f90'
data uth8z/0.d0/,imin0/-99/ data uth8z/0.d0/,imin0/-99/
save save
auxra=0. auxra=0.
i=index(cauxra,':') i=index(cauxra,':')
if(i.eq.0) then if(i.eq.0) then
read(cauxra,*,err=1,end=1) auxra read(cauxra,*,err=1,end=1) auxra
else else
read(cauxra(1:i-1),*,err=1,end=1) ih read(cauxra(1:i-1),*,err=1,end=1) ih
read(cauxra(i+1:i+2),*,err=1,end=1) im read(cauxra(i+1:i+2),*,err=1,end=1) im
read(cauxra(i+4:i+5),*,err=1,end=1) is read(cauxra(i+4:i+5),*,err=1,end=1) is
auxra=ih + im/60.0 + is/3600.0 auxra=ih + im/60.0 + is/3600.0
endif endif
1 auxdec=0. 1 auxdec=0.
i=index(cauxdec,':') i=index(cauxdec,':')
if(i.eq.0) then if(i.eq.0) then
read(cauxdec,*,err=2,end=2) auxdec read(cauxdec,*,err=2,end=2) auxdec
else else
read(cauxdec(1:i-1),*,err=2,end=2) id read(cauxdec(1:i-1),*,err=2,end=2) id
read(cauxdec(i+1:i+2),*,err=2,end=2) im read(cauxdec(i+1:i+2),*,err=2,end=2) im
read(cauxdec(i+4:i+5),*,err=2,end=2) is read(cauxdec(i+4:i+5),*,err=2,end=2) is
auxdec=id + im/60.0 + is/3600.0 auxdec=id + im/60.0 + is/3600.0
endif endif
2 nmode=1 2 nmode=1
if(mode(1:4).eq.'JT65') then if(mode(1:4).eq.'JT65') then
nmode=2 nmode=2
if(mode(5:5).eq.'A') mode65=1 if(mode(5:5).eq.'A') mode65=1
if(mode(5:5).eq.'B') mode65=2 if(mode(5:5).eq.'B') mode65=2
if(mode(5:5).eq.'C') mode65=4 if(mode(5:5).eq.'C') mode65=4
endif endif
if(mode.eq.'Echo') nmode=3 if(mode.eq.'Echo') nmode=3
if(mode.eq.'JT6M') nmode=4 if(mode.eq.'JT6M') nmode=4
uth=uth8 uth=uth8
call astro(AppDir,nyear,month,nday,uth,nfreq,hisgrid,2,nmode,1, & call astro(AppDir,nyear,month,nday,uth,nfreq,hisgrid,2,nmode,1, &
AzSun,ElSun,AzMoon,ElMoon,ntsky,doppler00,doppler, & AzSun,ElSun,AzMoon,ElMoon,ntsky,doppler00,doppler, &
dbMoon,RAMoon,DecMoon,HA,Dgrd,sd,poloffset,xnr,auxra,auxdec, & dbMoon,RAMoon,DecMoon,HA,Dgrd,sd,poloffset,xnr,auxra,auxdec, &
AzAux,ElAux) AzAux,ElAux)
AzMoonB8=AzMoon AzMoonB8=AzMoon
ElMoonB8=ElMoon ElMoonB8=ElMoon
call astro(AppDir,nyear,month,nday,uth,nfreq,grid,1,nmode,1, & call astro(AppDir,nyear,month,nday,uth,nfreq,grid,1,nmode,1, &
AzSun,ElSun,AzMoon,ElMoon,ntsky,doppler00,doppler, & AzSun,ElSun,AzMoon,ElMoon,ntsky,doppler00,doppler, &
dbMoon,RAMoon,DecMoon,HA,Dgrd,sd,poloffset,xnr,auxra,auxdec, & dbMoon,RAMoon,DecMoon,HA,Dgrd,sd,poloffset,xnr,auxra,auxdec, &
AzAux,ElAux) AzAux,ElAux)
RaAux8=auxra RaAux8=auxra
DecAux8=auxdec DecAux8=auxdec
AzSun8=AzSun AzSun8=AzSun
ElSun8=ElSun ElSun8=ElSun
AzMoon8=AzMoon AzMoon8=AzMoon
ElMoon8=ElMoon ElMoon8=ElMoon
dbMoon8=dbMoon dbMoon8=dbMoon
RAMoon8=RAMoon/15.0 RAMoon8=RAMoon/15.0
DecMoon8=DecMoon DecMoon8=DecMoon
HA8=HA HA8=HA
Dgrd8=Dgrd Dgrd8=Dgrd
sd8=sd sd8=sd
poloffset8=poloffset poloffset8=poloffset
xnr8=xnr xnr8=xnr
AzAux8=AzAux AzAux8=AzAux
ElAux8=ElAux ElAux8=ElAux
ndop=nint(doppler) ndop=nint(doppler)
ndop00=nint(doppler00) ndop00=nint(doppler00)
if(uth8z.eq.0.d0) then if(uth8z.eq.0.d0) then
uth8z=uth8-1.d0/3600.d0 uth8z=uth8-1.d0/3600.d0
dopplerz=doppler dopplerz=doppler
doppler00z=doppler00 doppler00z=doppler00
endif endif
dt=60.0*(uth8-uth8z) dt=60.0*(uth8-uth8z)
if(dt.le.0) dt=1.d0/60.d0 if(dt.le.0) dt=1.d0/60.d0
dfdt=(doppler-dopplerz)/dt dfdt=(doppler-dopplerz)/dt
dfdt0=(doppler00-doppler00z)/dt dfdt0=(doppler00-doppler00z)/dt
uth8z=uth8 uth8z=uth8
dopplerz=doppler dopplerz=doppler
doppler00z=doppler00 doppler00z=doppler00
imin=60*uth8 imin=60*uth8
isec=3600*uth8 isec=3600*uth8
if(isec.ne.isec0 .and. ndecoding.eq.0) then if(isec.ne.isec0 .and. ndecoding.eq.0) then
ih=uth8 ih=uth8
im=mod(imin,60) im=mod(imin,60)
is=mod(isec,60) is=mod(isec,60)
rewind 14 rewind 14
write(14,1010) ih,im,is,AzMoon,ElMoon, & write(14,1010) ih,im,is,AzMoon,ElMoon, &
ih,im,is,AzSun,ElSun, & ih,im,is,AzSun,ElSun, &
ih,im,is,AzAux,ElAux, & ih,im,is,AzAux,ElAux, &
nfreq,doppler,dfdt,doppler00,dfdt0, & nfreq,doppler,dfdt,doppler00,dfdt0, &
mousefqso,nsetftx mousefqso,nsetftx
1010 format(i2.2,':',i2.2,':',i2.2,',',f5.1,',',f5.1,',Moon'/ & 1010 format(i2.2,':',i2.2,':',i2.2,',',f5.1,',',f5.1,',Moon'/ &
i2.2,':',i2.2,':',i2.2,',',f5.1,',',f5.1,',Sun'/ & i2.2,':',i2.2,':',i2.2,',',f5.1,',',f5.1,',Sun'/ &
i2.2,':',i2.2,':',i2.2,',',f5.1,',',f5.1,',Source'/ & i2.2,':',i2.2,':',i2.2,',',f5.1,',',f5.1,',Source'/ &
i4,',',f8.1,',',f8.2,',',f8.1,',',f8.2,',Doppler'/ & i4,',',f8.1,',',f8.2,',',f8.1,',',f8.2,',Doppler'/ &
i4,',',i1,',fQSO') i4,',',i1,',fQSO')
call flushqqq(14) call flushqqq(14)
nsetftx=0 nsetftx=0
isec0=isec isec0=isec
endif endif
return return
end subroutine astro0 end subroutine astro0

148
audio_init.F90
View File

@ -1,74 +1,74 @@
!------------------------------------------------ audio_init !------------------------------------------------ audio_init
subroutine audio_init(ndin,ndout) subroutine audio_init(ndin,ndout)
#ifdef CVF #ifdef CVF
use dfmt use dfmt
integer Thread1,Thread2,Thread3 integer Thread1,Thread2,Thread3
external a2d,decode1,recvpkt external a2d,decode1,recvpkt
#endif #endif
include 'gcom1.f90' include 'gcom1.f90'
include 'gcom2.f90' include 'gcom2.f90'
nmode=2 nmode=2
if(mode(5:5).eq.'A') mode65=1 if(mode(5:5).eq.'A') mode65=1
if(mode(5:5).eq.'B') mode65=2 if(mode(5:5).eq.'B') mode65=2
if(mode(5:5).eq.'C') mode65=4 if(mode(5:5).eq.'C') mode65=4
ndevout=ndout ndevout=ndout
TxOK=0 TxOK=0
Transmitting=0 Transmitting=0
nfsample=11025 nfsample=11025
nspb=1024 nspb=1024
nbufs=2048 nbufs=2048
nmax=nbufs*nspb nmax=nbufs*nspb
nwave=60*nfsample nwave=60*nfsample
ngo=1 ngo=1
f0=800.0 f0=800.0
do i=1,nwave do i=1,nwave
iwave(i)=nint(32767.0*sin(6.283185307*i*f0/nfsample)) iwave(i)=nint(32767.0*sin(6.283185307*i*f0/nfsample))
enddo enddo
#ifdef CVF #ifdef CVF
! Priority classes (for processes): ! Priority classes (for processes):
! IDLE_PRIORITY_CLASS 64 ! IDLE_PRIORITY_CLASS 64
! NORMAL_PRIORITY_CLASS 32 ! NORMAL_PRIORITY_CLASS 32
! HIGH_PRIORITY_CLASS 128 ! HIGH_PRIORITY_CLASS 128
! Priority definitions (for threads): ! Priority definitions (for threads):
! THREAD_PRIORITY_IDLE -15 ! THREAD_PRIORITY_IDLE -15
! THREAD_PRIORITY_LOWEST -2 ! THREAD_PRIORITY_LOWEST -2
! THREAD_PRIORITY_BELOW_NORMAL -1 ! THREAD_PRIORITY_BELOW_NORMAL -1
! THREAD_PRIORITY_NORMAL 0 ! THREAD_PRIORITY_NORMAL 0
! THREAD_PRIORITY_ABOVE_NORMAL 1 ! THREAD_PRIORITY_ABOVE_NORMAL 1
! THREAD_PRIORITY_HIGHEST 2 ! THREAD_PRIORITY_HIGHEST 2
! THREAD_PRIORITY_TIME_CRITICAL 15 ! THREAD_PRIORITY_TIME_CRITICAL 15
m0=SetPriorityClass(GetCurrentProcess(),NORMAL_PRIORITY_CLASS) m0=SetPriorityClass(GetCurrentProcess(),NORMAL_PRIORITY_CLASS)
! m0=SetPriorityClass(GetCurrentProcess(),HIGH_PRIORITY_CLASS) ! m0=SetPriorityClass(GetCurrentProcess(),HIGH_PRIORITY_CLASS)
! Start a thread for doing A/D and D/A with sound card. ! Start a thread for doing A/D and D/A with sound card.
! (actually, only D/A is used in MAP65) ! (actually, only D/A is used in MAP65)
Thread1=CreateThread(0,0,a2d,0,CREATE_SUSPENDED,id1) Thread1=CreateThread(0,0,a2d,0,CREATE_SUSPENDED,id1)
m1=SetThreadPriority(Thread1,THREAD_PRIORITY_ABOVE_NORMAL) m1=SetThreadPriority(Thread1,THREAD_PRIORITY_ABOVE_NORMAL)
m2=ResumeThread(Thread1) m2=ResumeThread(Thread1)
! Start a thread for background decoding. ! Start a thread for background decoding.
Thread2=CreateThread(0,0,decode1,0,CREATE_SUSPENDED,id2) Thread2=CreateThread(0,0,decode1,0,CREATE_SUSPENDED,id2)
m3=SetThreadPriority(Thread2,THREAD_PRIORITY_BELOW_NORMAL) m3=SetThreadPriority(Thread2,THREAD_PRIORITY_BELOW_NORMAL)
m4=ResumeThread(Thread2) m4=ResumeThread(Thread2)
! Start a thread to receive packets from Linrad ! Start a thread to receive packets from Linrad
Thread3=CreateThread(0,0,recvpkt,0,CREATE_SUSPENDED,id3) Thread3=CreateThread(0,0,recvpkt,0,CREATE_SUSPENDED,id3)
m5=SetThreadPriority(Thread3,THREAD_PRIORITY_ABOVE_NORMAL) m5=SetThreadPriority(Thread3,THREAD_PRIORITY_ABOVE_NORMAL)
m6=ResumeThread(Thread3) m6=ResumeThread(Thread3)
#else #else
! print*,'Audio INIT called.' ! print*,'Audio INIT called.'
ierr=start_threads(ndevin,ndevout,y1,y2,nmax,iwrite,iwave,nwave, & ierr=start_threads(ndevin,ndevout,y1,y2,nmax,iwrite,iwave,nwave, &
11025,NSPB,TRPeriod,TxOK,ndebug,Transmitting, & 11025,NSPB,TRPeriod,TxOK,ndebug,Transmitting, &
Tsec,ngo,nmode,tbuf,ibuf,ndsec,PttPort,devin_name,devout_name) Tsec,ngo,nmode,tbuf,ibuf,ndsec,PttPort,devin_name,devout_name)
#endif #endif
return return
end subroutine audio_init end subroutine audio_init

28
azdist0.f90
View File

@ -1,14 +1,14 @@
!---------------------------------------------------- azdist0 !---------------------------------------------------- azdist0
subroutine azdist0(MyGrid,HisGrid,utch,nAz,nEl,nDmiles,nDkm,nHotAz,nHotABetter) subroutine azdist0(MyGrid,HisGrid,utch,nAz,nEl,nDmiles,nDkm,nHotAz,nHotABetter)
character*6 MyGrid,HisGrid character*6 MyGrid,HisGrid
real*8 utch real*8 utch
!f2py intent(in) MyGrid,HisGrid,utch !f2py intent(in) MyGrid,HisGrid,utch
!f2py intent(out) nAz,nEl,nDmiles,nDkm,nHotAz,nHotABetter !f2py intent(out) nAz,nEl,nDmiles,nDkm,nHotAz,nHotABetter
if(hisgrid(5:5).eq.' ' .or. ichar(hisgrid(5:5)).eq.0) hisgrid(5:5)='m' if(hisgrid(5:5).eq.' ' .or. ichar(hisgrid(5:5)).eq.0) hisgrid(5:5)='m'
if(hisgrid(6:6).eq.' ' .or. ichar(hisgrid(6:6)).eq.0) hisgrid(6:6)='m' if(hisgrid(6:6).eq.' ' .or. ichar(hisgrid(6:6)).eq.0) hisgrid(6:6)='m'
call azdist(MyGrid,HisGrid,utch,nAz,nEl,nDmiles,nDkm,nHotAz,nHotABetter) call azdist(MyGrid,HisGrid,utch,nAz,nEl,nDmiles,nDkm,nHotAz,nHotABetter)
return return
end subroutine azdist0 end subroutine azdist0

8397
configure vendored
View File

File diff suppressed because it is too large Load Diff

207
configure.ac
View File

@ -1,12 +1,12 @@
dnl $Id$ dnl $Id$
dnl Process this file with autoconf to produce a configure script. dnl Process this file with autoconf to produce a configure script.
dnl AC_PREREQ(2.59) dnl AC_PREREQ(2.61)
dnl Sneaky way to get an Id tag into the configure script dnl Sneaky way to get an Id tag into the configure script
AC_COPYRIGHT([$Id$]) AC_COPYRIGHT([$Id$])
AC_INIT([wsjt],[5.9.6]) AC_INIT([map65],[0.9])
AC_PREFIX_DEFAULT(/usr/local/) AC_PREFIX_DEFAULT(/usr/local/)
@ -20,7 +20,7 @@ dnl Make sure autoconf doesn't interfere with cflags -jmallett
CFLAGS="$OLD_CFLAGS" CFLAGS="$OLD_CFLAGS"
dnl Lets guess at some likely places for extra libs/includes XXX -db dnl Lets guess at some likely places for extra libs/includes XXX -db
CPPFLAGS="-Iportaudio-v19/include -I/usr/local/include -I/usr/include/alsa -I/usr/local/include/alsa ${CPPFLAGS}" CPPFLAGS="-I/usr/local/include ${CPPFLAGS}"
LDFLAGS="-L/usr/local/lib ${LDFLAGS}" LDFLAGS="-L/usr/local/lib ${LDFLAGS}"
LIBS=" -lpthread ${LIBS}" LIBS=" -lpthread ${LIBS}"
@ -86,11 +86,7 @@ AC_MSG_CHECKING([g95 lib path])
G95_LIB_PATH=`${G95} -print-file-name=` G95_LIB_PATH=`${G95} -print-file-name=`
AC_MSG_RESULT(${G95_LIB_PATH}) AC_MSG_RESULT(${G95_LIB_PATH})
AC_PATH_PROG(GFORTRAN, gfortran) AC_PATH_PROG(GFORTRAN, gfortran)
dnl AC_PATH_PROG(GFORTRAN, gfortran43)
dnl FreeBSD currently installs gfortran as gfortran41
dnl See http://gcc.gnu.org/fortran/
dnl
AC_PATH_PROG(GFORTRAN, gfortran41)
AC_MSG_CHECKING([gfortran lib path]) AC_MSG_CHECKING([gfortran lib path])
GFORTRAN_LIB_PATH=`${GFORTRAN} -print-file-name=` GFORTRAN_LIB_PATH=`${GFORTRAN} -print-file-name=`
AC_MSG_RESULT(${GFORTRAN_LIB_PATH}) AC_MSG_RESULT(${GFORTRAN_LIB_PATH})
@ -108,18 +104,12 @@ sys/resource.h linux/ppdev.h dev/ppbus/ppi.h sys/stat.h fcntl.h sys/ioctl.h ])
AC_HEADER_TIME AC_HEADER_TIME
AC_CHECK_HEADER([sys/soundcard.h], [HAS_SOUNDCARD_H=1], [HAS_SOUNDCARD_H=0])
AC_CHECK_HEADER([alsa/asoundlib.h], [HAS_ASOUNDLIB_H=1], [HAS_ASOUNDLIB_H=0])
AC_CHECK_HEADER([jack/jack.h], [HAS_JACK_H=1], [HAS_JACK_H=0])
if test -e "portaudio-v19/include/portaudio.h" ; then
echo "Checking for portaudio...yes"
HAS_PORTAUDIO_H=1
else
echo "Checking for portaudio...no"
HAS_PORTAUDIO_H=0
fi
AC_CHECK_HEADER([samplerate.h], [HAS_SAMPLERATE_H=1], [HAS_SAMPLERATE_H=0]) AC_CHECK_HEADER([samplerate.h], [HAS_SAMPLERATE_H=1], [HAS_SAMPLERATE_H=0])
HAS_PORTAUDIO_H=0
HAS_PORTAUDIO_LIB=0
HAS_PORTAUDIO=0
dnl See whether we can include both string.h and strings.h. dnl See whether we can include both string.h and strings.h.
AC_CACHE_CHECK([whether string.h and strings.h may both be included], AC_CACHE_CHECK([whether string.h and strings.h may both be included],
gcc_cv_header_string, gcc_cv_header_string,
@ -215,27 +205,6 @@ AC_CONFIG_FILES( \
Makefile Makefile
) )
dnl alsa soundsupport
dnl =================
AC_ARG_ENABLE(alsa,
AC_HELP_STRING([--enable-alsa],[Force ALSA SOUNDCARD usage.]),
[alsa=$enableval] , [alsa=no])
dnl oss soundsupport
dnl ================
AC_ARG_ENABLE(oss,
AC_HELP_STRING([--enable-oss],[Force OSS SOUND usage.]),
[oss=$enableval] , [oss=no])
dnl portaudio soundsupport
dnl ======================
AC_ARG_ENABLE(portaudio,
AC_HELP_STRING([--enable-portaudio],[Force PORTAUDIO SOUND usage.]),
[portaudio=$enableval], [portaudio=no])
dnl pick gfortran or g95 dnl pick gfortran or g95
dnl ==================== dnl ====================
@ -286,86 +255,90 @@ dnl set defaults
dnl ============ dnl ============
if test "$alsa" != yes -a "$oss" != yes -a \ AC_MSG_CHECKING([for a v19 portaudio ])
"$portaudio" != yes; then
if test $HAS_PORTAUDIO_H -eq 1; then portaudio_lib_dir="/usr/lib"
[portaudio=yes]; portaudio_include_dir="/usr/include"
elif test $HAS_ASOUNDLIB_H -eq 1; then
[alsa=yes]; AC_ARG_WITH([portaudio-include-dir],
elif test $HAS_SOUNDCARD_H -eq 1; then AC_HELP_STRING([--with-portaudio-include-dir=<path>],
[oss=yes]; [path to portaudio include files]),
[portaudio_include_dir=$with_portaudio_include_dir])
AC_ARG_WITH([portaudio-lib-dir],
AC_HELP_STRING([--with-portaudio-lib-dir=<path>],
[path to portaudio lib files]),
[portaudio_lib_dir=$with_portaudio_lib_dir])
if test -e ${portaudio_include_dir}/portaudio.h; then
HAS_PORTAUDIO_H=1
fi
if test -e ${portaudio_lib_dir}/libportaudio.so \
-o -e ${portaudio_lib_dir}/libportaudio.a;then
HAS_PORTAUDIO_LIB=1
fi
if test $HAS_PORTAUDIO_H -eq 1 -a $HAS_PORTAUDIO_LIB -eq 1; then
LDFLAGS="-L${portaudio_lib_dir} ${LDFLAGS}"
LIBS="${LIBS} -lportaudio"
CPPFLAGS="-I${portaudio_include_dir} ${CPPFLAGS}"
AC_CHECK_LIB(portaudio, Pa_GetVersion, \
[HAS_PORTAUDIO_VERSION=1], [HAS_PORTAUDIO_VERSION=0])
if test $HAS_PORTAUDIO_VERSION -eq 0; then
AC_MSG_RESULT([This is likely portaudio v18; you need portaudio v19])
else
HAS_PORTAUDIO=1
fi fi
fi
if test "$alsa" = yes; then
AC_DEFINE(USE_ALSA, 1, [Define if you want ALSA used.])
AC_SUBST(AUDIO, "start_alsa.c")
LIBS="${LIBS} -lasound"
fi
if test "$oss" = yes; then
AC_DEFINE(USE_OSS, 1, [Define if you want OSS used.])
AC_SUBST(AUDIO, "start_oss.c")
fi
if test "$portaudio" = yes; then
AC_DEFINE(USE_PORTAUDIO, 1, [Define if you want PORTAUDIO used.])
AC_SUBST(AUDIO, "a2d.f90 jtaudio.c resample.c start_portaudio.c")
AC_SUBST(NEEDPORTAUDIO, "portaudio-v19/lib/.libs/libportaudio.a")
dnl
dnl new portaudio-v19 on linux will be referencing alsa.
dnl
LIBS="${LIBS} ${RTLIBS} -lsamplerate ./portaudio-v19/lib/.libs/libportaudio.a"
LIBS="${LIBS} ${ASOUNDLIBS}"
else else
AC_SUBST(NEEDPORTAUDIO, "") AC_MSG_RESULT([portaudio not found trying FreeBSD paths ])
fi portaudio_lib_dir="/usr/local/lib/portaudio2"
portaudio_include_dir="/usr/local/include/portaudio2"
dnl
dnl Try again to make sure portaudio dirs are valid
dnl
AC_MSG_CHECKING([for a v19 portaudio in FreeBSD paths.])
HAS_PORTAUDIO_H=0
HAS_PORTAUDIO_LIB=0
dnl set conf flags if test -e ${portaudio_include_dir}/portaudio.h; then
dnl ============== HAS_PORTAUDIO_H=1
fi
if test $HAS_ASOUNDLIB_H -eq 1; then if test -e ${portaudio_lib_dir}/libportaudio.so \
AC_DEFINE(HAS_ASOUNDLIB_H, 1, ) -o -e ${portaudio_lib_dir}/libportaudio.a;then
fi HAS_PORTAUDIO_LIB=1
fi
if test $HAS_SOUNDCARD_H -eq 1; then if test $HAS_PORTAUDIO_H -eq 1 -a $HAS_PORTAUDIO_LIB -eq 1; then
AC_DEFINE(HAS_SOUNDCARD_H, 1, ) AC_MSG_RESULT([found portaudio in FreeBSD paths, double checking it is v19 ])
fi LDFLAGS="-L${portaudio_lib_dir} ${LDFLAGS}"
LIBS="${LIBS} -lportaudio"
if test $HAS_JACK_H -eq 1; then CPPFLAGS="-I${portaudio_include_dir} ${CPPFLAGS}"
AC_DEFINE(HAS_JACK_H, 1, ) AC_CHECK_LIB(portaudio, Pa_GetVersion, \
fi [HAS_PORTAUDIO_VERSION=1], [HAS_PORTAUDIO_VERSION=0])
if test $HAS_PORTAUDIO_VERSION -eq 0; then
if test $HAS_PORTAUDIO_H -eq 1; then AC_MSG_RESULT([How did you end up with a portaudio v18 here?])
AC_DEFINE(HAS_PORTAUDIO_H, 1, ) else
fi AC_MSG_RESULT([found v19])
HAS_PORTAUDIO=1
if test $HAS_SAMPLERATE_H -eq 1; then HAS_PORTAUDIO_H=1
AC_DEFINE(HAS_SAMPLERATE_H, 1, ) fi
fi
fi fi
dnl sanity tests. dnl sanity tests.
dnl ============= dnl =============
if test "$alsa" = yes; then if test $HAS_PORTAUDIO -eq 1; then
if test $HAS_ASOUNDLIB_H -eq 0; then AC_DEFINE(HAS_PORTAUDIO, 1, )
AC_MSG_ERROR([You need asoundlib.h to use --enable-alsa]) AC_DEFINE(HAS_PORTAUDIO_H, 1, )
fi AC_DEFINE(HAS_PORTAUDIO_LIB, 1, )
fi else
fail=1
if test "$oss" = yes; then echo "This program needs portaudio v19 to compile."
if test $HAS_SOUNDCARD_H -eq 0; then echo "Please use --with-portaudio-include-dir= and"
AC_MSG_ERROR([You need soundcard.h to use --enable-oss]) echo " --with-portaudio-lib-dir= to set the paths."
fi
fi
if test "$portaudio" = yes; then
if test $HAS_PORTAUDIO_H -eq 0; then
AC_MSG_ERROR([You need portaudio.h to use --enable-portaudio])
fi
if test $HAS_SAMPLERATE_H -eq 0; then
AC_MSG_ERROR([You need samplerate.h to use --enable-portaudio])
fi
fi fi
if test "$F2PY" = ""; then if test "$F2PY" = ""; then
@ -386,26 +359,14 @@ dnl do summary
echo echo
echo echo
if test $g95 == "yes"; then if test $g95 = "yes"; then
echo "Using g95 as fortran compiler."; echo "Using g95 as fortran compiler.";
fi fi
if test $gfortran == "yes"; then if test $gfortran = "yes"; then
echo "Using gfortran as fortran compiler."; echo "Using gfortran as fortran compiler.";
fi fi
if test $portaudio == "yes"; then
echo "Using portaudio.";
fi
if test $alsa == "yes"; then
echo "Using alsa.";
fi
if test $oss == "yes"; then
echo "Using oss.";
fi
echo echo
echo "Compiling $PACKAGE_NAME $PACKAGE_VERSION" echo "Compiling $PACKAGE_NAME $PACKAGE_VERSION"
echo echo

10
datcom.f90
View File

@ -1,5 +1,5 @@
parameter (NSMAX=60*96000) !Samples per 60 s file parameter (NSMAX=60*96000) !Samples per 60 s file
integer*2 id !46 MB: raw data from Linrad timf2 integer*2 id !46 MB: raw data from Linrad timf2
character*80 fname80 character*80 fname80
common/datcom/id(4,NSMAX,2),nutc,newdat2,kbuf,kxp,kk,kkdone,nlost, & common/datcom/id(4,NSMAX,2),nutc,newdat2,kbuf,kxp,kk,kkdone,nlost, &
nlen,fname80 nlen,fname80

162
decode1.F90
View File

@ -1,81 +1,81 @@
subroutine decode1(iarg) subroutine decode1(iarg)
! Get data and parameters from gcom, then call the decoders when needed. ! Get data and parameters from gcom, then call the decoders when needed.
! This routine runs in a background thread and will never return. ! This routine runs in a background thread and will never return.
#ifdef CVF #ifdef CVF
use dflib use dflib
#endif #endif
character sending0*28,mode0*6,cshort*11 character sending0*28,mode0*6,cshort*11
integer sendingsh0 integer sendingsh0
include 'datcom.f90' include 'datcom.f90'
include 'gcom1.f90' include 'gcom1.f90'
include 'gcom2.f90' include 'gcom2.f90'
include 'gcom3.f90' include 'gcom3.f90'
include 'gcom4.f90' include 'gcom4.f90'
data kbuf0/0/,ns00/-999/ data kbuf0/0/,ns00/-999/
data sending0/' '/ data sending0/' '/
save save
kkdone=-99 kkdone=-99
ns0=999999 ns0=999999
10 continue 10 continue
if(newdat2.gt.0) then if(newdat2.gt.0) then
call getfile2(fname80,nlen) call getfile2(fname80,nlen)
newdat2=0 newdat2=0
kbuf=1 kbuf=1
kk=NSMAX kk=NSMAX
kkdone=0 kkdone=0
newdat=1 newdat=1
endif endif
if(kbuf.ne.kbuf0) kkdone=0 if(kbuf.ne.kbuf0) kkdone=0
kbuf0=kbuf kbuf0=kbuf
kkk=kk kkk=kk
if(kbuf.eq.2) kkk=kk-5760000 if(kbuf.eq.2) kkk=kk-5760000
n=Tsec n=Tsec
if((ndiskdat.eq.1 .or. ndecoding.eq.0) .and. ((kkk-kkdone).gt.32768)) then if((ndiskdat.eq.1 .or. ndecoding.eq.0) .and. ((kkk-kkdone).gt.32768)) then
call symspec(id,kbuf,kk,kkdone,nutc,newdat) call symspec(id,kbuf,kk,kkdone,nutc,newdat)
call sleep_msec(10) call sleep_msec(10)
endif endif
if(ndecoding.gt.0 .and. mode(1:4).eq.'JT65') then if(ndecoding.gt.0 .and. mode(1:4).eq.'JT65') then
ndecdone=0 ndecdone=0
call map65a(newdat) call map65a(newdat)
if(mousebutton.eq.0) ndecoding0=ndecoding if(mousebutton.eq.0) ndecoding0=ndecoding
ndecoding=0 ndecoding=0
endif endif
if(ns0.lt.0) then if(ns0.lt.0) then
rewind 21 rewind 21
ns0=999999 ns0=999999
endif endif
if(n.lt.ns0 .and. utcdate(1:1).eq.'2') then if(n.lt.ns0 .and. utcdate(1:1).eq.'2') then
write(21,1001) utcdate(:11) write(21,1001) utcdate(:11)
1001 format(/'UTC Date: ',a11/'---------------------') 1001 format(/'UTC Date: ',a11/'---------------------')
ns0=n ns0=n
endif endif
if(transmitting.eq.1 .and. (sending.ne.sending0 .or. & if(transmitting.eq.1 .and. (sending.ne.sending0 .or. &
sendingsh.ne.sendingsh0 .or. mode.ne.mode0)) then sendingsh.ne.sendingsh0 .or. mode.ne.mode0)) then
ih=n/3600 ih=n/3600
im=mod(n/60,60) im=mod(n/60,60)
is=mod(n,60) is=mod(n,60)
cshort=' ' cshort=' '
if(sendingsh.eq.1) cshort='(Shorthand)' if(sendingsh.eq.1) cshort='(Shorthand)'
write(21,1010) ih,im,is,mode,sending,cshort write(21,1010) ih,im,is,mode,sending,cshort
1010 format(3i2.2,' Transmitting: ',a6,2x,a28,2x,a11) 1010 format(3i2.2,' Transmitting: ',a6,2x,a28,2x,a11)
call flushqqq(21) call flushqqq(21)
sending0=sending sending0=sending
sendingsh0=sendingsh sendingsh0=sendingsh
mode0=mode mode0=mode
endif endif
call sleep_msec(100) !### was 100 call sleep_msec(100) !### was 100
go to 10 go to 10
end subroutine decode1 end subroutine decode1

342
display.F90
View File

@ -1,171 +1,171 @@
subroutine display(nkeep,ncsmin) subroutine display(nkeep,ncsmin)
#ifdef CVF #ifdef CVF
use dfport use dfport
#endif #endif
parameter (MAXLINES=500,MX=500) parameter (MAXLINES=500,MX=500)
integer indx(MAXLINES),indx2(MX) integer indx(MAXLINES),indx2(MX)
character*81 line(MAXLINES),line2(MX),line3(MAXLINES) character*81 line(MAXLINES),line2(MX),line3(MAXLINES)
character out*50,cfreq0*3 character out*50,cfreq0*3
character*6 callsign,callsign0 character*6 callsign,callsign0
character*12 freqcall(100) character*12 freqcall(100)
character*40 bm2 character*40 bm2
real freqkHz(MAXLINES) real freqkHz(MAXLINES)
integer utc(MAXLINES),utc2(MX),utcz integer utc(MAXLINES),utc2(MX),utcz
real*8 f0 real*8 f0
ftol=0.02 ftol=0.02
rewind 26 rewind 26
do i=1,MAXLINES do i=1,MAXLINES
read(26,1010,end=10) line(i) read(26,1010,end=10) line(i)
1010 format(a80) 1010 format(a80)
read(line(i),1020) f0,ndf,nh,nm read(line(i),1020) f0,ndf,nh,nm
1020 format(f7.3,i5,26x,i3,i2) 1020 format(f7.3,i5,26x,i3,i2)
utc(i)=60*nh + nm utc(i)=60*nh + nm
freqkHz(i)=1000.d0*(f0-144.d0) + 0.001d0*ndf freqkHz(i)=1000.d0*(f0-144.d0) + 0.001d0*ndf
enddo enddo
10 nz=i-1 10 nz=i-1
utcz=utc(nz) utcz=utc(nz)
nz=nz-1 nz=nz-1
if(nz.lt.1) go to 999 if(nz.lt.1) go to 999
nquad=max(nkeep/4,3) nquad=max(nkeep/4,3)
do i=1,nz do i=1,nz
nage=utcz-utc(i) nage=utcz-utc(i)
if(nage.lt.0) nage=nage+1440 if(nage.lt.0) nage=nage+1440
iage=(nage/nquad) + 1 iage=(nage/nquad) + 1
if(nage.le.1) iage=0 if(nage.le.1) iage=0
write(line(i)(78:81),1021) iage write(line(i)(78:81),1021) iage
1021 format(i4) 1021 format(i4)
enddo enddo
nage=utcz-utc(1) nage=utcz-utc(1)
if(nage.lt.0) nage=nage+1440 if(nage.lt.0) nage=nage+1440
if(nage.gt.nkeep) then if(nage.gt.nkeep) then
do i=1,nz do i=1,nz
nage=utcz-utc(i) nage=utcz-utc(i)
if(nage.lt.0) nage=nage+1440 if(nage.lt.0) nage=nage+1440
if(nage.le.nkeep) go to 20 if(nage.le.nkeep) go to 20
enddo enddo
20 i0=i 20 i0=i
nz=nz-i0+1 nz=nz-i0+1
rewind 26 rewind 26
if(nz.lt.1) go to 999 if(nz.lt.1) go to 999
do i=1,nz do i=1,nz
j=i+i0-1 j=i+i0-1
line(i)=line(j) line(i)=line(j)
utc(i)=utc(j) utc(i)=utc(j)
freqkHz(i)=freqkHz(j) freqkHz(i)=freqkHz(j)
write(26,1010) line(i) write(26,1010) line(i)
enddo enddo
endif endif
call flushqqq(26) call flushqqq(26)
call indexx(nz,freqkHz,indx) call indexx(nz,freqkHz,indx)
nstart=1 nstart=1
k3=0 k3=0
k=1 k=1
m=indx(1) m=indx(1)
if(m.lt.1 .or. m.gt.MAXLINES) then if(m.lt.1 .or. m.gt.MAXLINES) then
print*,'Error in display.F90: ',nz,m print*,'Error in display.F90: ',nz,m
m=1 m=1
endif endif
line2(1)=line(m) line2(1)=line(m)
utc2(1)=utc(m) utc2(1)=utc(m)
do i=2,nz do i=2,nz
j0=indx(i-1) j0=indx(i-1)
j=indx(i) j=indx(i)
if(freqkHz(j)-freqkHz(j0).gt.ftol) then if(freqkHz(j)-freqkHz(j0).gt.ftol) then
if(nstart.eq.0) then if(nstart.eq.0) then
k=k+1 k=k+1
line2(k)="" line2(k)=""
utc2(k)=-1 utc2(k)=-1
endif endif
kz=k kz=k
if(nstart.eq.1) then if(nstart.eq.1) then
call indexx(kz,utc2,indx2) call indexx(kz,utc2,indx2)
k3=0 k3=0
do k=1,kz do k=1,kz
k3=k3+1 k3=k3+1
line3(k3)=line2(indx2(k)) line3(k3)=line2(indx2(k))
enddo enddo
nstart=0 nstart=0
else else
call indexx(kz,utc2,indx2) call indexx(kz,utc2,indx2)
do k=1,kz do k=1,kz
k3=k3+1 k3=k3+1
line3(k3)=line2(indx2(k)) line3(k3)=line2(indx2(k))
enddo enddo
endif endif
k=0 k=0
endif endif
if(i.eq.nz) then if(i.eq.nz) then
k=k+1 k=k+1
line2(k)="" line2(k)=""
utc2(k)=-1 utc2(k)=-1
endif endif
k=k+1 k=k+1
line2(k)=line(j) line2(k)=line(j)
utc2(k)=utc(j) utc2(k)=utc(j)
j0=j j0=j
enddo enddo
kz=k kz=k
call indexx(kz,utc2,indx2) call indexx(kz,utc2,indx2)
do k=1,kz do k=1,kz
k3=k3+1 k3=k3+1
line3(k3)=line2(indx2(k)) line3(k3)=line2(indx2(k))
enddo enddo
rewind 19 rewind 19
rewind 20 rewind 20
cfreq0=' ' cfreq0=' '
nc=0 nc=0
callsign0=' ' callsign0=' '
do k=1,k3 do k=1,k3
out=line3(k)(5:12)//line3(k)(28:31)//line3(k)(39:43)// & out=line3(k)(5:12)//line3(k)(28:31)//line3(k)(39:43)// &
line3(k)(35:38)//line3(k)(44:67)//line3(k)(77:81) line3(k)(35:38)//line3(k)(44:67)//line3(k)(77:81)
if(out(1:3).ne.' ') then if(out(1:3).ne.' ') then
if(out(1:3).eq.cfreq0) then if(out(1:3).eq.cfreq0) then
out(1:3)=' ' out(1:3)=' '
else else
cfreq0=out(1:3) cfreq0=out(1:3)
endif endif
write(19,1030) out write(19,1030) out
1030 format(a50) 1030 format(a50)
i1=index(out(24:),' ') i1=index(out(24:),' ')
callsign=out(i1+24:) callsign=out(i1+24:)
i2=index(callsign,' ') i2=index(callsign,' ')
if(i2.gt.1) callsign(i2:)=' ' if(i2.gt.1) callsign(i2:)=' '
if(callsign.ne.' ' .and. callsign.ne.callsign0) then if(callsign.ne.' ' .and. callsign.ne.callsign0) then
len=i2-1 len=i2-1
if(len.lt.0) len=6 if(len.lt.0) len=6
if(len.ge.ncsmin) then !Omit short "callsigns" if(len.ge.ncsmin) then !Omit short "callsigns"
nc=nc+1 nc=nc+1
freqcall(nc)=cfreq0//' '//callsign//line3(k)(80:81) freqcall(nc)=cfreq0//' '//callsign//line3(k)(80:81)
callsign0=callsign callsign0=callsign
endif endif
endif endif
if(callsign.ne.' ' .and. callsign.eq.callsign0) then if(callsign.ne.' ' .and. callsign.eq.callsign0) then
freqcall(nc)=cfreq0//' '//callsign//line3(k)(80:81) freqcall(nc)=cfreq0//' '//callsign//line3(k)(80:81)
endif endif
endif endif
enddo enddo
call flushqqq(19) call flushqqq(19)
nc=nc+1 nc=nc+1
freqcall(nc)=' ' freqcall(nc)=' '
nc=nc+1 nc=nc+1
freqcall(nc)=' ' freqcall(nc)=' '
freqcall(nc+1)=' ' freqcall(nc+1)=' '
freqcall(nc+2)=' ' freqcall(nc+2)=' '
iz=(nc+2)/3 iz=(nc+2)/3
do i=1,iz do i=1,iz
bm2=freqcall(i)//' '//freqcall(i+iz)//' '//freqcall(i+2*iz) bm2=freqcall(i)//' '//freqcall(i+iz)//' '//freqcall(i+2*iz)
write(20,1040) bm2 write(20,1040) bm2
1040 format(a40) 1040 format(a40)
enddo enddo
call flushqqq(20) call flushqqq(20)
999 return 999 return
end subroutine display end subroutine display

500
fivehz.F90
View File

@ -1,250 +1,250 @@
subroutine fivehz subroutine fivehz
! Called at interrupt level from the PortAudio callback routine. ! Called at interrupt level from the PortAudio callback routine.
! For nspb=2048 the callback rate is nfsample/nspb = 5.38 Hz. ! For nspb=2048 the callback rate is nfsample/nspb = 5.38 Hz.
! Thus, we should be able to control the timing of T/R sequence events ! Thus, we should be able to control the timing of T/R sequence events
! here to within about 0.2 s. ! here to within about 0.2 s.
! Do not do anything very time consuming in this routine!! ! Do not do anything very time consuming in this routine!!
! Disk I/O is a bad idea. Writing to stdout (for diagnostic purposes) ! Disk I/O is a bad idea. Writing to stdout (for diagnostic purposes)
! seems to be OK. ! seems to be OK.
#ifdef CVF #ifdef CVF
use dflib use dflib
use dfport use dfport
#endif #endif
parameter (NTRING=64) parameter (NTRING=64)
real*8 tt1(0:NTRING-1) real*8 tt1(0:NTRING-1)
logical first,txtime,filled logical first,txtime,filled
integer ptt integer ptt
integer TxOKz integer TxOKz
real*8 fs,fsample,tt,u real*8 fs,fsample,tt,u
include 'gcom1.f90' include 'gcom1.f90'
include 'gcom2.f90' include 'gcom2.f90'
data first/.true./,nc0/1/,nc1/1/ data first/.true./,nc0/1/,nc1/1/
save save
n1=time() n1=time()
n2=mod(n1,86400) n2=mod(n1,86400)
tt=n1-n2+tsec-0.1d0*ndsec tt=n1-n2+tsec-0.1d0*ndsec
if(first) then if(first) then
rxdelay=0.2 rxdelay=0.2
txdelay=0.4 txdelay=0.4
tlatency=1.0 tlatency=1.0
first=.false. first=.false.
iptt=0 iptt=0
ntr0=-99 ntr0=-99
rxdone=.false. rxdone=.false.
ibuf00=-99 ibuf00=-99
ncall=-1 ncall=-1
u=0.05d0 u=0.05d0
fsample=11025.d0 fsample=11025.d0
mfsample=110250 mfsample=110250
filled=.false. filled=.false.
endif endif
if(txdelay.lt.0.2d0) txdelay=0.2d0 if(txdelay.lt.0.2d0) txdelay=0.2d0
! Measure average sampling frequency over a recent interval ! Measure average sampling frequency over a recent interval
ncall=ncall+1 ncall=ncall+1
if(ncall.eq.9) then if(ncall.eq.9) then
ntt0=0 ntt0=0
ntt1=0 ntt1=0
tt1(ntt1)=tt tt1(ntt1)=tt
endif endif
! if(ncall.ge.10 .and. mod(ncall,2).eq.1) then ! if(ncall.ge.10 .and. mod(ncall,2).eq.1) then
if(ncall.ge.10) then if(ncall.ge.10) then
ntt1=iand(ntt1+1,NTRING-1) ntt1=iand(ntt1+1,NTRING-1)
tt1(ntt1)=tt tt1(ntt1)=tt
if(ntt1.eq.NTRING-1) filled=.true. if(ntt1.eq.NTRING-1) filled=.true.
if(filled) ntt0=iand(ntt1+1,NTRING-1) if(filled) ntt0=iand(ntt1+1,NTRING-1)
if(mod(ncall,2).eq.1) then if(mod(ncall,2).eq.1) then
nd=ntt1-ntt0 nd=ntt1-ntt0
if(nd.lt.0) nd=nd+NTRING if(nd.lt.0) nd=nd+NTRING
fs=nd*2048.d0/(tt1(ntt1)-tt1(ntt0)) fs=nd*2048.d0/(tt1(ntt1)-tt1(ntt0))
fsample=u*fs + (1.d0-u)*fsample fsample=u*fs + (1.d0-u)*fsample
mfsample=nint(10.d0*fsample) mfsample=nint(10.d0*fsample)
endif endif
endif endif
if(trperiod.le.0) trperiod=30 if(trperiod.le.0) trperiod=30
tx1=0.0 !Time to start a TX sequence tx1=0.0 !Time to start a TX sequence
tx2=trperiod-(tlatency+txdelay) !Time to turn TX off tx2=trperiod-(tlatency+txdelay) !Time to turn TX off
if(mode(1:4).eq.'JT65') then if(mode(1:4).eq.'JT65') then
if(nwave.lt.126*4096) nwave=126*4096 if(nwave.lt.126*4096) nwave=126*4096
tx2=txdelay + nwave/11025.0 tx2=txdelay + nwave/11025.0
if(tx2.gt.(trperiod-2.0)) tx2=trperiod-tlatency-1.0 if(tx2.gt.(trperiod-2.0)) tx2=trperiod-tlatency-1.0
endif endif
if(TxFirst.eq.0) then if(TxFirst.eq.0) then
tx1=tx1+trperiod tx1=tx1+trperiod
tx2=tx2+trperiod tx2=tx2+trperiod
endif endif
t=mod(Tsec,2.d0*trperiod) t=mod(Tsec,2.d0*trperiod)
txtime = t.ge.tx1 .and. t.lt.tx2 txtime = t.ge.tx1 .and. t.lt.tx2
! If we're transmitting, freeze the input buffer pointers where they were. ! If we're transmitting, freeze the input buffer pointers where they were.
receiving=1 receiving=1
if(((txtime .and. (lauto.eq.1)) .or. TxOK.eq.1 .or. transmitting.eq.1) & if(((txtime .and. (lauto.eq.1)) .or. TxOK.eq.1 .or. transmitting.eq.1) &
.and. (mute.eq.0)) then .and. (mute.eq.0)) then
receiving=0 receiving=0
ibuf=ibuf000 ibuf=ibuf000
iwrite=iwrite000 iwrite=iwrite000
endif endif
ibuf000=ibuf ibuf000=ibuf
iwrite000=iwrite iwrite000=iwrite
nsec=Tsec nsec=Tsec
ntr=mod(nsec/trperiod,2) !ntr=0 in 1st sequence, 1 in 2nd ntr=mod(nsec/trperiod,2) !ntr=0 in 1st sequence, 1 in 2nd
if(ntr.ne.ntr0) then if(ntr.ne.ntr0) then
ibuf0=ibuf !Start of new sequence, save ibuf ibuf0=ibuf !Start of new sequence, save ibuf
! if(mode(1:4).ne.'JT65') then ! if(mode(1:4).ne.'JT65') then
! ibuf0=ibuf0+3 !So we don't copy our own Tx ! ibuf0=ibuf0+3 !So we don't copy our own Tx
! if(ibuf0.gt.1024) ibuf0=ibuf0-1024 ! if(ibuf0.gt.1024) ibuf0=ibuf0-1024
! endif ! endif
ntime=time() !Save start time ntime=time() !Save start time
if(mantx.eq.1 .and. iptt.eq.1) then if(mantx.eq.1 .and. iptt.eq.1) then
mantx=0 mantx=0
TxOK=0 TxOK=0
endif endif
endif endif
! Switch PTT line and TxOK appropriately ! Switch PTT line and TxOK appropriately
if(lauto.eq.1) then if(lauto.eq.1) then
if(txtime .and. iptt.eq.0 .and. & if(txtime .and. iptt.eq.0 .and. &
mute.eq.0) i1=ptt(nport,pttport,1,iptt) !Raise PTT mute.eq.0) i1=ptt(nport,pttport,1,iptt) !Raise PTT
if(.not.txtime .or. mute.eq.1) TxOK=0 !Lower TxOK if(.not.txtime .or. mute.eq.1) TxOK=0 !Lower TxOK
else else
if(mantx.eq.1 .and. iptt.eq.0 .and. & if(mantx.eq.1 .and. iptt.eq.0 .and. &
mute.eq.0) i2=ptt(nport,pttport,1,iptt) !Raise PTT mute.eq.0) i2=ptt(nport,pttport,1,iptt) !Raise PTT
if(mantx.eq.0 .or. mute.eq.1) TxOK=0 !Lower TxOK if(mantx.eq.0 .or. mute.eq.1) TxOK=0 !Lower TxOK
endif endif
! Calculate Tx waveform as needed ! Calculate Tx waveform as needed
if((iptt.eq.1 .and. iptt0.eq.0) .or. nrestart.eq.1) then if((iptt.eq.1 .and. iptt0.eq.0) .or. nrestart.eq.1) then
call wsjtgen call wsjtgen
nrestart=0 nrestart=0
endif endif
! If PTT was just raised, start a countdown for raising TxOK: ! If PTT was just raised, start a countdown for raising TxOK:
nc1a=txdelay/0.18576 nc1a=txdelay/0.18576
if(nc1a.lt.2) nc1a=2 if(nc1a.lt.2) nc1a=2
if(iptt.eq.1 .and. iptt0.eq.0) nc1=-nc1a-1 if(iptt.eq.1 .and. iptt0.eq.0) nc1=-nc1a-1
if(nc1.le.0) nc1=nc1+1 if(nc1.le.0) nc1=nc1+1
if(nc1.eq.0) TxOK=1 ! We are transmitting if(nc1.eq.0) TxOK=1 ! We are transmitting
! If TxOK was just lowered, start a countdown for lowering PTT: ! If TxOK was just lowered, start a countdown for lowering PTT:
nc0a=(tlatency+txdelay)/0.18576 nc0a=(tlatency+txdelay)/0.18576
if(nc0a.lt.5) nc0a=5 if(nc0a.lt.5) nc0a=5
if(TxOK.eq.0 .and. TxOKz.eq.1 .and. iptt.eq.1) nc0=-nc0a-1 if(TxOK.eq.0 .and. TxOKz.eq.1 .and. iptt.eq.1) nc0=-nc0a-1
if(nc0.le.0) nc0=nc0+1 if(nc0.le.0) nc0=nc0+1
if(nc0.eq.0) i3=ptt(nport,pttport,0,iptt) if(nc0.eq.0) i3=ptt(nport,pttport,0,iptt)
if(iptt.eq.0 .and.TxOK.eq.0) then if(iptt.eq.0 .and.TxOK.eq.0) then
sending=" " sending=" "
sendingsh=0 sendingsh=0
endif endif
nbufs=ibuf-ibuf0 nbufs=ibuf-ibuf0
if(nbufs.lt.0) nbufs=nbufs+1024 if(nbufs.lt.0) nbufs=nbufs+1024
tdata=nbufs*2048.0/11025.0 tdata=nbufs*2048.0/11025.0
if(mode(1:4).eq.'JT65' .and. monitoring.eq.1 .and. tdata.gt.53.0 & if(mode(1:4).eq.'JT65' .and. monitoring.eq.1 .and. tdata.gt.53.0 &
.and. ibuf0.ne.ibuf00) then .and. ibuf0.ne.ibuf00) then
rxdone=.true. rxdone=.true.
ibuf00=ibuf0 ibuf00=ibuf0
endif endif
iptt0=iptt iptt0=iptt
TxOKz=TxOK TxOKz=TxOK
ntr0=ntr ntr0=ntr
return return
end subroutine fivehz end subroutine fivehz
subroutine fivehztx subroutine fivehztx
! Called at interrupt level from the PortAudio output callback. ! Called at interrupt level from the PortAudio output callback.
#ifdef CVF #ifdef CVF
use dflib use dflib
use dfport use dfport
#endif #endif
parameter (NTRING=64) parameter (NTRING=64)
real*8 tt1(0:NTRING-1) real*8 tt1(0:NTRING-1)
logical first,filled logical first,filled
real*8 fs,fsample,tt,u real*8 fs,fsample,tt,u
include 'gcom1.f90' include 'gcom1.f90'
data first/.true./ data first/.true./
save save
n1=time() n1=time()
n2=mod(n1,86400) n2=mod(n1,86400)
tt=n1-n2+tsec-0.1d0*ndsec tt=n1-n2+tsec-0.1d0*ndsec
if(first) then if(first) then
first=.false. first=.false.
ncall=-1 ncall=-1
fsample=11025.d0 fsample=11025.d0
u=0.05d0 u=0.05d0
mfsample2=110250 mfsample2=110250
filled=.false. filled=.false.
endif endif
! Measure average sampling frequency over a recent interval ! Measure average sampling frequency over a recent interval
ncall=ncall+1 ncall=ncall+1
if(ncall.eq.9) then if(ncall.eq.9) then
ntt0=0 ntt0=0
ntt1=0 ntt1=0
tt1(ntt1)=tt tt1(ntt1)=tt
endif endif
if(ncall.ge.10) then if(ncall.ge.10) then
ntt1=iand(ntt1+1,NTRING-1) ntt1=iand(ntt1+1,NTRING-1)
tt1(ntt1)=tt tt1(ntt1)=tt
if(ntt1.eq.NTRING-1) filled=.true. if(ntt1.eq.NTRING-1) filled=.true.
if(filled) ntt0=iand(ntt1+1,NTRING-1) if(filled) ntt0=iand(ntt1+1,NTRING-1)
if(mod(ncall,2).eq.1) then if(mod(ncall,2).eq.1) then
nd=ntt1-ntt0 nd=ntt1-ntt0
if(nd.lt.0) nd=nd+NTRING if(nd.lt.0) nd=nd+NTRING
fs=nd*2048.d0/(tt1(ntt1)-tt1(ntt0)) fs=nd*2048.d0/(tt1(ntt1)-tt1(ntt0))
fsample=u*fs + (1.d0-u)*fsample fsample=u*fs + (1.d0-u)*fsample
mfsample2=nint(10.d0*fsample) mfsample2=nint(10.d0*fsample)
endif endif
endif endif
return return
end subroutine fivehztx end subroutine fivehztx
subroutine addnoise(n) subroutine addnoise(n)
integer*2 n integer*2 n
real*8 txsnrdb0 real*8 txsnrdb0
include 'gcom1.f90' include 'gcom1.f90'
data idum/0/ data idum/0/
save save
if(txsnrdb.gt.40.0) return if(txsnrdb.gt.40.0) return
if(txsnrdb.ne.txsnrdb0) then if(txsnrdb.ne.txsnrdb0) then
snr=10.0**(0.05*(txsnrdb-1)) snr=10.0**(0.05*(txsnrdb-1))
fac=3000.0 fac=3000.0
if(snr.gt.1.0) fac=3000.0/snr if(snr.gt.1.0) fac=3000.0/snr
txsnrdb0=txsnrdb txsnrdb0=txsnrdb
endif endif
i=fac*(gran(idum) + n*snr/32768.0) i=fac*(gran(idum) + n*snr/32768.0)
if(i>32767) i=32767; if(i>32767) i=32767;
if(i<-32767) i=-32767; if(i<-32767) i=-32767;
n=i n=i
return return
end subroutine addnoise end subroutine addnoise
real function gran(idum) real function gran(idum)
real r(12) real r(12)
if(idum.lt.0) then if(idum.lt.0) then
call random_seed call random_seed
idum=0 idum=0
endif endif
call random_number(r) call random_number(r)
gran=sum(r)-6.0 gran=sum(r)-6.0
end function gran end function gran

330
ftn_init.F90
View File

@ -1,165 +1,165 @@
! Fortran logical units used in WSJT6 ! Fortran logical units used in WSJT6
! !
! 10 binary input data, *.tf2 files ! 10 binary input data, *.tf2 files
! 11 decoded.txt ! 11 decoded.txt
! 12 decoded.ave ! 12 decoded.ave
! 13 tsky.dat ! 13 tsky.dat
! 14 azel.dat ! 14 azel.dat
! 15 ! 15
! 16 ! 16
! 17 saved *.tf2 files ! 17 saved *.tf2 files
! 18 test file to be transmitted (wsjtgen.f90) ! 18 test file to be transmitted (wsjtgen.f90)
! 19 messages.txt ! 19 messages.txt
! 20 bandmap.txt ! 20 bandmap.txt
! 21 ALL65.TXT ! 21 ALL65.TXT
! 22 kvasd.dat ! 22 kvasd.dat
! 23 CALL3.TXT ! 23 CALL3.TXT
! 24 meas24.dat ! 24 meas24.dat
! 25 meas25.dat ! 25 meas25.dat
! 26 tmp26.txt ! 26 tmp26.txt
! 27 dphi.txt ! 27 dphi.txt
! 28 ! 28
! 29 debug.txt ! 29 debug.txt
!------------------------------------------------ ftn_init !------------------------------------------------ ftn_init
subroutine ftn_init subroutine ftn_init
character*1 cjunk character*1 cjunk
integer ptt integer ptt
include 'gcom1.f90' include 'gcom1.f90'
include 'gcom2.f90' include 'gcom2.f90'
include 'gcom3.f90' include 'gcom3.f90'
include 'gcom4.f90' include 'gcom4.f90'
! print*,'ftn_init.F90 nport=', nport, 'pttport=', pttport ! print*,'ftn_init.F90 nport=', nport, 'pttport=', pttport
i=ptt(nport,pttport,0,iptt) !Clear the PTT line i=ptt(nport,pttport,0,iptt) !Clear the PTT line
addpfx=' ' addpfx=' '
nrw26=0 nrw26=0
do i=80,1,-1 do i=80,1,-1
if(AppDir(i:i).ne.' ') goto 1 if(AppDir(i:i).ne.' ') goto 1
enddo enddo
1 iz=i 1 iz=i
lenappdir=iz lenappdir=iz
call pfxdump(appdir(:iz)//'/prefixes.txt') call pfxdump(appdir(:iz)//'/prefixes.txt')
do i=80,1,-1 do i=80,1,-1
if(AzElDir(i:i).ne.' ') goto 2 if(AzElDir(i:i).ne.' ') goto 2
enddo enddo
2 iz2=i 2 iz2=i
#ifdef CVF #ifdef CVF
open(11,file=appdir(:iz)//'/decoded.txt',status='unknown', & open(11,file=appdir(:iz)//'/decoded.txt',status='unknown', &
share='denynone',err=910) share='denynone',err=910)
#else #else
open(11,file=appdir(:iz)//'/decoded.txt',status='unknown', & open(11,file=appdir(:iz)//'/decoded.txt',status='unknown', &
err=910) err=910)
#endif #endif
endfile 11 endfile 11
#ifdef CVF #ifdef CVF
open(12,file=appdir(:iz)//'/decoded.ave',status='unknown', & open(12,file=appdir(:iz)//'/decoded.ave',status='unknown', &
share='denynone',err=920) share='denynone',err=920)
#else #else
open(12,file=appdir(:iz)//'/decoded.ave',status='unknown', & open(12,file=appdir(:iz)//'/decoded.ave',status='unknown', &
err=920) err=920)
#endif #endif
endfile 12 endfile 12
#ifdef CVF #ifdef CVF
open(14,file=azeldir(:iz2)//'/azel.dat',status='unknown', & open(14,file=azeldir(:iz2)//'/azel.dat',status='unknown', &
share='denynone',err=930) share='denynone',err=930)
#else #else
open(14,file=azeldir(:iz2)//'/azel.dat',status='unknown', & open(14,file=azeldir(:iz2)//'/azel.dat',status='unknown', &
err=930) err=930)
#endif #endif
#ifdef CVF #ifdef CVF
open(19,file=appdir(:iz)//'/messages.txt',status='unknown', & open(19,file=appdir(:iz)//'/messages.txt',status='unknown', &
share='denynone',err=911) share='denynone',err=911)
#else #else
open(19,file=appdir(:iz)//'/messages.txt',status='unknown', & open(19,file=appdir(:iz)//'/messages.txt',status='unknown', &
err=911) err=911)
#endif #endif
endfile 19 endfile 19
#ifdef CVF #ifdef CVF
open(20,file=appdir(:iz)//'/bandmap.txt',status='unknown', & open(20,file=appdir(:iz)//'/bandmap.txt',status='unknown', &
share='denynone',err=912) share='denynone',err=912)
#else #else
open(20,file=appdir(:iz)//'/bandmap.txt',status='unknown', & open(20,file=appdir(:iz)//'/bandmap.txt',status='unknown', &
err=912) err=912)
#endif #endif
endfile 20 endfile 20
#ifdef CVF #ifdef CVF
open(21,file=appdir(:iz)//'/ALL65.TXT',status='unknown', & open(21,file=appdir(:iz)//'/ALL65.TXT',status='unknown', &
access='append',share='denynone',err=950) access='append',share='denynone',err=950)
#else #else
open(21,file=appdir(:iz)//'/ALL65.TXT',status='unknown', & open(21,file=appdir(:iz)//'/ALL65.TXT',status='unknown', &
access='append',err=950) access='append',err=950)
do i=1,9999999 do i=1,9999999
read(21,*,end=10) cjunk read(21,*,end=10) cjunk
enddo enddo
10 continue 10 continue
#endif #endif
#ifdef CVF #ifdef CVF
open(22,file=appdir(:iz)//'/kvasd.dat',access='direct',recl=1024, & open(22,file=appdir(:iz)//'/kvasd.dat',access='direct',recl=1024, &
status='unknown',share='denynone') status='unknown',share='denynone')
#else #else
open(22,file=appdir(:iz)//'/kvasd.dat',access='direct',recl=1024, & open(22,file=appdir(:iz)//'/kvasd.dat',access='direct',recl=1024, &
status='unknown') status='unknown')
#endif #endif
#ifdef CVF #ifdef CVF
open(24,file=appdir(:iz)//'/meas24.txt',status='unknown', & open(24,file=appdir(:iz)//'/meas24.txt',status='unknown', &
share='denynone') share='denynone')
#else #else
open(24,file=appdir(:iz)//'/meas24.txt',status='unknown') open(24,file=appdir(:iz)//'/meas24.txt',status='unknown')
#endif #endif
#ifdef CVF #ifdef CVF
open(25,file=appdir(:iz)//'/meas25.txt',status='unknown', & open(25,file=appdir(:iz)//'/meas25.txt',status='unknown', &
share='denynone') share='denynone')
#else #else
open(25,file=appdir(:iz)//'/meas25.txt',status='unknown') open(25,file=appdir(:iz)//'/meas25.txt',status='unknown')
#endif #endif
#ifdef CVF #ifdef CVF
open(26,file=appdir(:iz)//'/tmp26.txt',status='unknown', & open(26,file=appdir(:iz)//'/tmp26.txt',status='unknown', &
share='denynone') share='denynone')
#else #else
open(26,file=appdir(:iz)//'/tmp26.txt',status='unknown') open(26,file=appdir(:iz)//'/tmp26.txt',status='unknown')
#endif #endif
#ifdef CVF #ifdef CVF
open(27,file=appdir(:iz)//'/dphi.txt',status='unknown', & open(27,file=appdir(:iz)//'/dphi.txt',status='unknown', &
share='denynone') share='denynone')
#else #else
open(27,file=appdir(:iz)//'/dphi.txt',status='unknown') open(27,file=appdir(:iz)//'/dphi.txt',status='unknown')
#endif #endif
#ifdef CVF #ifdef CVF
open(29,file=appdir(:iz)//'/debug.txt',status='unknown', & open(29,file=appdir(:iz)//'/debug.txt',status='unknown', &
share='denynone') share='denynone')
#else #else
open(29,file=appdir(:iz)//'/debug.txt',status='unknown') open(29,file=appdir(:iz)//'/debug.txt',status='unknown')
#endif #endif
return return
910 print*,'Error opening DECODED.TXT' 910 print*,'Error opening DECODED.TXT'
stop stop
911 print*,'Error opening messages.txt' 911 print*,'Error opening messages.txt'
stop stop
912 print*,'Error opening bandmap.txt' 912 print*,'Error opening bandmap.txt'
stop stop
920 print*,'Error opening DECODED.AVE' 920 print*,'Error opening DECODED.AVE'
stop stop
930 print*,'Error opening AZEL.DAT' 930 print*,'Error opening AZEL.DAT'
stop stop
950 print*,'Error opening ALL65.TXT' 950 print*,'Error opening ALL65.TXT'
stop stop
end subroutine ftn_init end subroutine ftn_init

18
ftn_quit.f90
View File

@ -1,9 +1,9 @@
!------------------------------------------------ ftn_quit !------------------------------------------------ ftn_quit
subroutine ftn_quit subroutine ftn_quit
include 'gcom1.f90' include 'gcom1.f90'
ngo=0 ngo=0
! Destroy the FFTW plans ! Destroy the FFTW plans
call four2a(a,-1,1,1,1) call four2a(a,-1,1,1,1)
call filbig(id,-1,f0,newdat,c4a,c4b,n4) call filbig(id,-1,f0,newdat,c4a,c4b,n4)
return return
end subroutine ftn_quit end subroutine ftn_quit

102
gcom1.f90
View File

@ -1,51 +1,51 @@
! Variable Purpose Set in Thread ! Variable Purpose Set in Thread
!--------------------------------------------------------------------------- !---------------------------------------------------------------------------
integer NRXMAX !Max length of Rx ring buffers integer NRXMAX !Max length of Rx ring buffers
integer NTXMAX !Max length of Tx waveform in samples integer NTXMAX !Max length of Tx waveform in samples
parameter(NRXMAX=2097152) ! =2048*1024 parameter(NRXMAX=2097152) ! =2048*1024
parameter(NTXMAX=1653750) ! =150*11025 parameter(NTXMAX=1653750) ! =150*11025
real*8 tbuf !Tsec at time of input callback SoundIn real*8 tbuf !Tsec at time of input callback SoundIn
integer ntrbuf !(obsolete?) integer ntrbuf !(obsolete?)
real*8 Tsec !Present time SoundIn,SoundOut real*8 Tsec !Present time SoundIn,SoundOut
real*8 rxdelay !Delay between PTT=1 and Tx audio SoundIn real*8 rxdelay !Delay between PTT=1 and Tx audio SoundIn
real*8 txdelay !Delay from end of Tx Audio and PTT=0 SoundOut real*8 txdelay !Delay from end of Tx Audio and PTT=0 SoundOut
real*8 samfacin !(Input sample rate)/11025 GUI real*8 samfacin !(Input sample rate)/11025 GUI
real*8 samfacout !(Output sample rate)/11025 GUI real*8 samfacout !(Output sample rate)/11025 GUI
real*8 txsnrdb !SNR for simulations GUI real*8 txsnrdb !SNR for simulations GUI
integer*2 y1 !Ring buffer for audio channel 0 SoundIn integer*2 y1 !Ring buffer for audio channel 0 SoundIn
integer*2 y2 !Ring buffer for audio channel 1 SoundIn integer*2 y2 !Ring buffer for audio channel 1 SoundIn
integer nmax !Actual length of Rx ring buffers GUI integer nmax !Actual length of Rx ring buffers GUI
integer iwrite !Write pointer to Rx ring buffer SoundIn integer iwrite !Write pointer to Rx ring buffer SoundIn
integer iread !Read pointer to Rx ring buffer GUI integer iread !Read pointer to Rx ring buffer GUI
integer*2 iwave !Data for audio output SoundIn integer*2 iwave !Data for audio output SoundIn
integer nwave !Number of samples in iwave SoundIn integer nwave !Number of samples in iwave SoundIn
integer TxOK !OK to transmit? SoundIn integer TxOK !OK to transmit? SoundIn
! NB: TxOK=1 only in SoundIn; TxOK=0 also in GUI ! NB: TxOK=1 only in SoundIn; TxOK=0 also in GUI
integer Receiving !Actually receiving? SoundIn integer Receiving !Actually receiving? SoundIn
integer Transmitting !Actually transmitting? SoundOut integer Transmitting !Actually transmitting? SoundOut
integer TxFirst !Transmit first? GUI integer TxFirst !Transmit first? GUI
integer TRPeriod !Tx or Rx period in seconds GUI integer TRPeriod !Tx or Rx period in seconds GUI
integer ibuf !Most recent input buffer# SoundIn integer ibuf !Most recent input buffer# SoundIn
integer ibuf0 !Buffer# at start of Rx sequence SoundIn integer ibuf0 !Buffer# at start of Rx sequence SoundIn
real ave !(why is this here?) GUI real ave !(why is this here?) GUI
real rms !(why is this here?) GUI real rms !(why is this here?) GUI
integer ngo !Set to 0 to terminate audio streams GUI integer ngo !Set to 0 to terminate audio streams GUI
integer level !S-meter level, 0-100 GUI integer level !S-meter level, 0-100 GUI
integer mute !True means "don't transmit" GUI integer mute !True means "don't transmit" GUI
integer newdat !New data available for waterfall? GUI integer newdat !New data available for waterfall? GUI
integer ndsec !Dsec in units of 0.1 s GUI integer ndsec !Dsec in units of 0.1 s GUI
integer ndevin !Device# for audio input GUI integer ndevin !Device# for audio input GUI
integer ndevout !Device# for audio output GUI integer ndevout !Device# for audio output GUI
integer mfsample !Measured sample rate, input SoundIn integer mfsample !Measured sample rate, input SoundIn
integer mfsample2 !Measured sample rate, output SoundOut integer mfsample2 !Measured sample rate, output SoundOut
integer ns0 !Time at last ALL.TXT date entry Decoder integer ns0 !Time at last ALL.TXT date entry Decoder
character*12 devin_name,devout_name ! GUI character*12 devin_name,devout_name ! GUI
common/gcom1/Tbuf(1024),ntrbuf(1024),Tsec,rxdelay,txdelay, & common/gcom1/Tbuf(1024),ntrbuf(1024),Tsec,rxdelay,txdelay, &
samfacin,samfacout,txsnrdb,y1(NRXMAX),y2(NRXMAX), & samfacin,samfacout,txsnrdb,y1(NRXMAX),y2(NRXMAX), &
nmax,iwrite,iread,iwave(NTXMAX),nwave,TxOK,Receiving,Transmitting, & nmax,iwrite,iread,iwave(NTXMAX),nwave,TxOK,Receiving,Transmitting, &
TxFirst,TRPeriod,ibuf,ibuf0,ave,rms,ngo,level,mute,newdat,ndsec, & TxFirst,TRPeriod,ibuf,ibuf0,ave,rms,ngo,level,mute,newdat,ndsec, &
ndevin,ndevout,mfsample,mfsample2,ns0,devin_name,devout_name ndevin,ndevout,mfsample,mfsample2,ns0,devin_name,devout_name
!### volatile /gcom1/ !### volatile /gcom1/

242
gcom2.f90
View File

@ -1,121 +1,121 @@
! Variable Purpose Set in Thread ! Variable Purpose Set in Thread
!------------------------------------------------------------------------- !-------------------------------------------------------------------------
real*8 fcenter !Linrad center freq, from pkt header recvpkt real*8 fcenter !Linrad center freq, from pkt header recvpkt
real ps0 !Spectrum of best ping, FSK441/JT6m Decoder real ps0 !Spectrum of best ping, FSK441/JT6m Decoder
real psavg !Average spectrum Decoder real psavg !Average spectrum Decoder
real s2 !2d spectrum for horizontal waterfall GUI real s2 !2d spectrum for horizontal waterfall GUI
real ccf !CCF in time (blue curve) Decoder real ccf !CCF in time (blue curve) Decoder
real green !Data for green line GUI real green !Data for green line GUI
real fselect !Specified QSO frequency GUI real fselect !Specified QSO frequency GUI
real pctlost !Percent of lost packets Decoder real pctlost !Percent of lost packets Decoder
real pctblank !Percent of blanked blocks/packets Decoder real pctblank !Percent of blanked blocks/packets Decoder
real rxnoise !Rx noise in dB recvpkt real rxnoise !Rx noise in dB recvpkt
real dphi !Phase shift between pol'n channels GUI,Decoder real dphi !Phase shift between pol'n channels GUI,Decoder
integer ngreen !Length of green GUI integer ngreen !Length of green GUI
real dgain !Digital audio gain setting GUI real dgain !Digital audio gain setting GUI
integer ndecoding !Decoder status (see decode2.f90) GUI,Decoder integer ndecoding !Decoder status (see decode2.f90) GUI,Decoder
integer ndecoding0 !Status on previous decode GUI,Decoder integer ndecoding0 !Status on previous decode GUI,Decoder
integer mousebutton !Which button was clicked? GUI integer mousebutton !Which button was clicked? GUI
integer multicast !1 for multicast data, 0 for unicast GUI integer multicast !1 for multicast data, 0 for unicast GUI
integer ndecdone !Is decoder finished? GUI,Decoder integer ndecdone !Is decoder finished? GUI,Decoder
integer ierr !Error opening *.tf2 file GUI integer ierr !Error opening *.tf2 file GUI
integer lauto !Are we in Auto mode? GUI integer lauto !Are we in Auto mode? GUI
integer mantx !Manual transmission requested? GUI,SoundIn integer mantx !Manual transmission requested? GUI,SoundIn
integer nrestart !True if transmission should restart GUI,SoundIn integer nrestart !True if transmission should restart GUI,SoundIn
integer ntr !Are we in 2nd sequence? SoundIn integer ntr !Are we in 2nd sequence? SoundIn
integer nmsg !Length of Tx message SoundIn integer nmsg !Length of Tx message SoundIn
integer nsave !Which files to save? GUI integer nsave !Which files to save? GUI
integer nadd5 !Prepend 5 sec of 0's before decoding? GUI integer nadd5 !Prepend 5 sec of 0's before decoding? GUI
integer dftolerance !DF tolerance (Hz) GUI integer dftolerance !DF tolerance (Hz) GUI
logical LDecoded !Was a message decoded? Decoder logical LDecoded !Was a message decoded? Decoder
logical rxdone !Has the Rx sequence finished? SoundIn,Decoder logical rxdone !Has the Rx sequence finished? SoundIn,Decoder
integer monitoring !Are we monitoring? GUI integer monitoring !Are we monitoring? GUI
integer nzap !Is Zap checked? GUI integer nzap !Is Zap checked? GUI
integer minsigdb !Decoder threshold setting GUI integer minsigdb !Decoder threshold setting GUI
integer nclearave !Set to 1 to clear JT65 avg GUI,Decoder integer nclearave !Set to 1 to clear JT65 avg GUI,Decoder
integer nfreeze !Is Freeze checked? GUI integer nfreeze !Is Freeze checked? GUI
integer nafc !Is AFC checked? GUI integer nafc !Is AFC checked? GUI
integer ncsmin !Minimum length of callsign in bandmap GUI integer ncsmin !Minimum length of callsign in bandmap GUI
integer newspec !New spectra in ss(4,322,NSMAX) GUI,Decoder integer newspec !New spectra in ss(4,322,NSMAX) GUI,Decoder
integer nfa !Low end of map65 search (def 100 kHz) GUI integer nfa !Low end of map65 search (def 100 kHz) GUI
integer nfb !High end of map65 search (def 160 kHz) GUI integer nfb !High end of map65 search (def 160 kHz) GUI
integer nfcal !Calibration offset, Hz GUI integer nfcal !Calibration offset, Hz GUI
integer idphi !Phase offset in Y channel (deg) GUI integer idphi !Phase offset in Y channel (deg) GUI
integer nkeep !Timeout limit for band maps (min) GUI integer nkeep !Timeout limit for band maps (min) GUI
integer nmode !Which WSJT mode? GUI,Decoder integer nmode !Which WSJT mode? GUI,Decoder
integer mode65 !JT65 sub-mode (A/B/C ==> 1/2/4) GUI,SoundIn,Decoder integer mode65 !JT65 sub-mode (A/B/C ==> 1/2/4) GUI,SoundIn,Decoder
integer nbpp !# FFT Bins/pixel, wideband waterfall Spec integer nbpp !# FFT Bins/pixel, wideband waterfall Spec
integer ndebug !Write debugging info? GUI integer ndebug !Write debugging info? GUI
integer ndphi !Set to 1 to compute dphi GUI,Decoder integer ndphi !Set to 1 to compute dphi GUI,Decoder
integer nhispol !Pol angle matching HisCall or HisGrid Decoder integer nhispol !Pol angle matching HisCall or HisGrid Decoder
integer nt1 !Time to start FFTs GUI integer nt1 !Time to start FFTs GUI
integer nblank !Is NB checked? GUI integer nblank !Is NB checked? GUI
integer nfmid !Center frequency of main display GUI integer nfmid !Center frequency of main display GUI
integer nfrange !Frequency range of main display GUI integer nfrange !Frequency range of main display GUI
integer nport !Requested COM port number GUI integer nport !Requested COM port number GUI
integer mousedf !Mouse-selected freq offset, DF GUI integer mousedf !Mouse-selected freq offset, DF GUI
integer mousefqso !Mouse-selected QSO freq GUI integer mousefqso !Mouse-selected QSO freq GUI
integer neme !EME calls only in deep search? GUI integer neme !EME calls only in deep search? GUI
integer nrw26 !Request to rewind lu 26 (tmp26.txt) GUI,Decoder integer nrw26 !Request to rewind lu 26 (tmp26.txt) GUI,Decoder
integer naggressive !Is "Aggressive decoding" checked? GUI integer naggressive !Is "Aggressive decoding" checked? GUI
integer ntx2 !Is "No shorthands if Tx1" checked? GUI integer ntx2 !Is "No shorthands if Tx1" checked? GUI
integer nagain !Decode same file again? GUI integer nagain !Decode same file again? GUI
integer shok !Shorthand messages OK? GUI integer shok !Shorthand messages OK? GUI
integer sendingsh !Sending a shorthand message? SoundIn integer sendingsh !Sending a shorthand message? SoundIn
integer*2 d2a !Rx data, extracted from y1 Decoder integer*2 d2a !Rx data, extracted from y1 Decoder
integer*2 d2b !Rx data, selected by mouse-pick Decoder integer*2 d2b !Rx data, selected by mouse-pick Decoder
integer*2 b !Pixel values for waterfall spectrum GUI integer*2 b !Pixel values for waterfall spectrum GUI
integer jza !Length of data in d2a GUI,Decoder integer jza !Length of data in d2a GUI,Decoder
integer jzb !(why is this here?) integer jzb !(why is this here?)
integer ntime !Integer Unix time (now) SoundIn integer ntime !Integer Unix time (now) SoundIn
integer idinterval !Interval between CWIDs, minutes GUI integer idinterval !Interval between CWIDs, minutes GUI
integer msmax !(why is this here?) integer msmax !(why is this here?)
integer lenappdir !Length of Appdir string GUI integer lenappdir !Length of Appdir string GUI
integer idf !Frequency offset in Hz Decoder integer idf !Frequency offset in Hz Decoder
integer ndiskdat !1 if data read from disk, 0 otherwise GUI integer ndiskdat !1 if data read from disk, 0 otherwise GUI
integer nlines !Available lines of waterfall data GUI integer nlines !Available lines of waterfall data GUI
integer nflat !Is waterfall to be flattened? GUI integer nflat !Is waterfall to be flattened? GUI
integer ntxreq !Tx msg# requested GUI integer ntxreq !Tx msg# requested GUI
integer ntxnow !Tx msg# being sent now GUI integer ntxnow !Tx msg# being sent now GUI
integer ndepth !Requested "depth" of JT65 decoding GUI integer ndepth !Requested "depth" of JT65 decoding GUI
integer nspecial !JT65 shorthand msg#: RO=2 RRR=3 73=4 Decoder integer nspecial !JT65 shorthand msg#: RO=2 RRR=3 73=4 Decoder
integer ndf !Measured DF in Hz Decoder integer ndf !Measured DF in Hz Decoder
real ss1 !Magenta curve for JT65 shorthand msg Decoder real ss1 !Magenta curve for JT65 shorthand msg Decoder
real ss2 !Orange curve for JT65 shorthand msg Decoder real ss2 !Orange curve for JT65 shorthand msg Decoder
character mycall*12 !My call sign GUI character mycall*12 !My call sign GUI
character hiscall*12 !His call sign GUI character hiscall*12 !His call sign GUI
character hisgrid*6 !His grid locator GUI character hisgrid*6 !His grid locator GUI
character txmsg*28 !Message to be transmitted GUI character txmsg*28 !Message to be transmitted GUI
character sending*28 !Message being sent SoundIn character sending*28 !Message being sent SoundIn
character mode*6 !WSJT operating mode GUI character mode*6 !WSJT operating mode GUI
character utcdate*12 !UTC date GUI character utcdate*12 !UTC date GUI
character*24 fname0 !Filenames to be recorded, read, ... Decoder character*24 fname0 !Filenames to be recorded, read, ... Decoder
character*24 fnamea character*24 fnamea
character*24 fnameb character*24 fnameb
character*6 fnamedate character*6 fnamedate
character*24 decodedfile character*24 decodedfile
character*80 AppDir !WSJT installation directory GUI character*80 AppDir !WSJT installation directory GUI
character*80 AzElDir !Directory for azel.dat GUI character*80 AzElDir !Directory for azel.dat GUI
character*80 SaveDir !Directory for saved data files GUI character*80 SaveDir !Directory for saved data files GUI
character*80 filetokilla !Filenames (full path) Decoder character*80 filetokilla !Filenames (full path) Decoder
character*80 filetokillb character*80 filetokillb
character*12 pttport character*12 pttport
character*8 utcdata !HHMM UTC for the processed data Decoder character*8 utcdata !HHMM UTC for the processed data Decoder
common/gcom2/fcenter,ps0(431),psavg(450),s2(64,3100),ccf(-5:540), & common/gcom2/fcenter,ps0(431),psavg(450),s2(64,3100),ccf(-5:540), &
green(500),fselect,pctlost,pctblank,rxnoise,dphi,ngreen,dgain, & green(500),fselect,pctlost,pctblank,rxnoise,dphi,ngreen,dgain, &
ndecoding,ndecoding0,mousebutton,multicast,nsetftx,ierr, & ndecoding,ndecoding0,mousebutton,multicast,nsetftx,ierr, &
ndecdone,lauto,mantx,nrestart,ntr,nmsg,nsave,nadd5, & ndecdone,lauto,mantx,nrestart,ntr,nmsg,nsave,nadd5, &
dftolerance,LDecoded,rxdone,monitoring,nzap,minsigdb, & dftolerance,LDecoded,rxdone,monitoring,nzap,minsigdb, &
nclearave,nfreeze,nafc,ncsmin,newspec,nfa,nfb,nfcal,idphi,nkeep, & nclearave,nfreeze,nafc,ncsmin,newspec,nfa,nfb,nfcal,idphi,nkeep, &
nmode,mode65,nbpp,ndebug,ndphi,nhispol,nt1, & nmode,mode65,nbpp,ndebug,ndphi,nhispol,nt1, &
nblank,nport,mousedf,mousefqso,neme,nrw26,naggressive,ntx2,nagain, & nblank,nport,mousedf,mousefqso,neme,nrw26,naggressive,ntx2,nagain, &
shok,sendingsh,d2a(661500),d2b(661500),b(60000),jza,jzb,ntime, & shok,sendingsh,d2a(661500),d2b(661500),b(60000),jza,jzb,ntime, &
idinterval,msmax,lenappdir,idf,ndiskdat,nlines,nflat,ntxreq,ntxnow, & idinterval,msmax,lenappdir,idf,ndiskdat,nlines,nflat,ntxreq,ntxnow, &
ndepth,nspecial,ndf,nfmid,nfrange,ss1(-224:224),ss2(-224:224), & ndepth,nspecial,ndf,nfmid,nfrange,ss1(-224:224),ss2(-224:224), &
mycall,hiscall,hisgrid,txmsg,sending,mode,fname0,fnamea, & mycall,hiscall,hisgrid,txmsg,sending,mode,fname0,fnamea, &
fnameb,fnamedate,decodedfile,AppDir,AzElDir,SaveDir, & fnameb,fnamedate,decodedfile,AppDir,AzElDir,SaveDir, &
filetokilla,filetokillb,utcdate,pttport,utcdata filetokilla,filetokillb,utcdate,pttport,utcdata
!### volatile /gcom2/ !### volatile /gcom2/

40
gcom3.f90
View File

@ -1,20 +1,20 @@
! Variable Purpose Set in Thread ! Variable Purpose Set in Thread
!------------------------------------------------------------------------- !-------------------------------------------------------------------------
integer*2 nfmt2 !Standard header for *.WAV file Decoder integer*2 nfmt2 !Standard header for *.WAV file Decoder
integer*2 nchan2 integer*2 nchan2
integer*2 nbitsam2 integer*2 nbitsam2
integer*2 nbytesam2 integer*2 nbytesam2
integer*4 nchunk integer*4 nchunk
integer*4 lenfmt integer*4 lenfmt
integer*4 nsamrate integer*4 nsamrate
integer*4 nbytesec integer*4 nbytesec
integer*4 ndata integer*4 ndata
character*4 ariff character*4 ariff
character*4 awave character*4 awave
character*4 afmt character*4 afmt
character*4 adata character*4 adata
common/gcom3/ariff,nchunk,awave,afmt,lenfmt,nfmt2,nchan2,nsamrate, & common/gcom3/ariff,nchunk,awave,afmt,lenfmt,nfmt2,nchan2,nsamrate, &
nbytesec,nbytesam2,nbitsam2,adata,ndata nbytesec,nbytesam2,nbitsam2,adata,ndata
!### volatile /gcom3/ !### volatile /gcom3/

20
gcom4.f90
View File

@ -1,10 +1,10 @@
! Variable Purpose Set in Thread ! Variable Purpose Set in Thread
!------------------------------------------------------------------------- !-------------------------------------------------------------------------
character addpfx*8 !Add-on prefix, as in ZA/PA2CHR GUI character addpfx*8 !Add-on prefix, as in ZA/PA2CHR GUI
integer*2 d2c !Rx data recovered from recorded file GUI integer*2 d2c !Rx data recovered from recorded file GUI
integer jzc !Length of data available in d2c GUI integer jzc !Length of data available in d2c GUI
character filename*24 !Name of wave file read from disk GUI character filename*24 !Name of wave file read from disk GUI
common/gcom4/addpfx,d2c(661500),jzc,filename common/gcom4/addpfx,d2c(661500),jzc,filename
!### volatile /gcom4/ !### volatile /gcom4/

28
getfile.F90
View File

@ -1,14 +1,14 @@
!----------------------------------------------------- getfile !----------------------------------------------------- getfile
subroutine getfile(fname,len) subroutine getfile(fname,len)
character*(*) fname character*(*) fname
include 'datcom.f90' include 'datcom.f90'
include 'gcom2.f90' include 'gcom2.f90'
fname80=fname fname80=fname
nlen=len nlen=len
newdat2=1 newdat2=1
ierr=0 ierr=0
return return
end subroutine getfile end subroutine getfile

118
getfile2.F90
View File

@ -1,59 +1,59 @@
subroutine getfile2(fname,len) subroutine getfile2(fname,len)
#ifdef CVF #ifdef CVF
use dflib use dflib
#endif #endif
character*(*) fname character*(*) fname
real*8 sq real*8 sq
include 'datcom.f90' include 'datcom.f90'
include 'gcom1.f90' include 'gcom1.f90'
include 'gcom2.f90' include 'gcom2.f90'
include 'gcom4.f90' include 'gcom4.f90'
1 if(ndecoding.eq.0) go to 2 1 if(ndecoding.eq.0) go to 2
#ifdef CVF #ifdef CVF
call sleepqq(100) call sleepqq(100)
#else #else
call usleep(100*1000) call usleep(100*1000)
#endif #endif
go to 1 go to 1
2 do i=len,1,-1 2 do i=len,1,-1
if(fname(i:i).eq.'/' .or. fname(i:i).eq.'\\') go to 10 if(fname(i:i).eq.'/' .or. fname(i:i).eq.'\\') go to 10
enddo enddo
i=0 i=0
10 filename=fname(i+1:) 10 filename=fname(i+1:)
ierr=0 ierr=0
n=8*NSMAX n=8*NSMAX
ndecoding=4 ndecoding=4
monitoring=0 monitoring=0
kbuf=1 kbuf=1
call rfile3a(fname,id,n,ierr) call rfile3a(fname,id,n,ierr)
if(ierr.ne.0) then if(ierr.ne.0) then
print*,'Error opening or reading file: ',fname,ierr print*,'Error opening or reading file: ',fname,ierr
go to 999 go to 999
endif endif
sq=0. sq=0.
ka=0.1*NSMAX ka=0.1*NSMAX
kb=0.8*NSMAX kb=0.8*NSMAX
do k=ka,kb do k=ka,kb
sq=sq + float(int(id(1,k,1)))**2 + float(int(id(2,k,1)))**2 + & sq=sq + float(int(id(1,k,1)))**2 + float(int(id(2,k,1)))**2 + &
float(int(id(3,k,1)))**2 + float(int(id(4,k,1)))**2 float(int(id(3,k,1)))**2 + float(int(id(4,k,1)))**2
enddo enddo
sqave=174*sq/(kb-ka+1) sqave=174*sq/(kb-ka+1)
rxnoise=10.0*log10(sqave) - 48.0 rxnoise=10.0*log10(sqave) - 48.0
read(filename(8:11),*,err=20,end=20) nutc read(filename(8:11),*,err=20,end=20) nutc
go to 30 go to 30
20 nutc=0 20 nutc=0
30 ndiskdat=1 30 ndiskdat=1
mousebutton=0 mousebutton=0
999 return 999 return
end subroutine getfile2 end subroutine getfile2

38
i1tor4.f90
View File

@ -1,19 +1,19 @@
!--------------------------------------------------- i1tor4 !--------------------------------------------------- i1tor4
subroutine i1tor4(d,jz,data) subroutine i1tor4(d,jz,data)
! Convert wavefile byte data from to real*4. ! Convert wavefile byte data from to real*4.
integer*1 d(jz) integer*1 d(jz)
real data(jz) real data(jz)
integer*1 i1 integer*1 i1
equivalence(i1,i4) equivalence(i1,i4)
do i=1,jz do i=1,jz
n=d(i) n=d(i)
i4=n-128 i4=n-128
data(i)=i1 data(i)=i1
enddo enddo
return return
end subroutine i1tor4 end subroutine i1tor4

778
map65a.F90
View File

@ -1,389 +1,389 @@
subroutine map65a(newdat) subroutine map65a(newdat)
! Processes timf2 data from Linrad to find and decode JT65 signals. ! Processes timf2 data from Linrad to find and decode JT65 signals.
parameter (MAXMSG=1000) !Size of decoded message list parameter (MAXMSG=1000) !Size of decoded message list
real tavg(-50:50) !Temp for finding local base level real tavg(-50:50) !Temp for finding local base level
real base(4) !Local basel level at 4 pol'ns real base(4) !Local basel level at 4 pol'ns
real tmp (200) !Temp storage for pctile sorting real tmp (200) !Temp storage for pctile sorting
real sig(MAXMSG,30) !Parameters of detected signals real sig(MAXMSG,30) !Parameters of detected signals
real a(5) real a(5)
character*22 msg(MAXMSG) character*22 msg(MAXMSG)
character*3 shmsg0(4) character*3 shmsg0(4)
integer indx(MAXMSG),nsiz(MAXMSG) integer indx(MAXMSG),nsiz(MAXMSG)
logical done(MAXMSG) logical done(MAXMSG)
character decoded*22,blank*22 character decoded*22,blank*22
include 'spcom.f90' include 'spcom.f90'
real short(3,NFFT) !SNR dt ipol for potential shorthands real short(3,NFFT) !SNR dt ipol for potential shorthands
real qphi(12) real qphi(12)
include 'gcom2.f90' include 'gcom2.f90'
include 'datcom.f90' include 'datcom.f90'
data blank/' '/ data blank/' '/
data shmsg0/'ATT','RO ','RRR','73 '/ data shmsg0/'ATT','RO ','RRR','73 '/
data nfile/0/,nutc0/-999/,nid/0/,ip000/1/,ip001/1/,mousefqso0/-999/ data nfile/0/,nutc0/-999/,nid/0/,ip000/1/,ip001/1/,mousefqso0/-999/
save save
if(mousefqso.ne.mousefqso0 .and. nagain.eq.1) newspec=2 if(mousefqso.ne.mousefqso0 .and. nagain.eq.1) newspec=2
mousefqso0=mousefqso mousefqso0=mousefqso
nfoffset=nint(1000*(fcenter-144.125d0)) nfoffset=nint(1000*(fcenter-144.125d0))
mfqso=mousefqso - nfoffset mfqso=mousefqso - nfoffset
rewind 11 rewind 11
rewind 12 rewind 12
if(nrw26.ne.0) then if(nrw26.ne.0) then
endfile (26) !Compiler bug? Don't write "end file 26" !!! endfile (26) !Compiler bug? Don't write "end file 26" !!!
rewind 26 rewind 26
rewind 19 rewind 19
endfile (19) endfile (19)
rewind 19 rewind 19
nrw26=0 nrw26=0
endif endif
#ifdef CVF #ifdef CVF
open(23,file='CALL3.TXT',status='unknown',share='denynone') open(23,file='CALL3.TXT',status='unknown',share='denynone')
#else #else
open(23,file='CALL3.TXT',status='unknown') open(23,file='CALL3.TXT',status='unknown')
#endif #endif
if(nutc.ne.nutc0) nfile=nfile+1 if(nutc.ne.nutc0) nfile=nfile+1
nutc0=nutc nutc0=nutc
df=96000.0/NFFT !df = 96000/NFFT = 2.930 Hz df=96000.0/NFFT !df = 96000/NFFT = 2.930 Hz
ftol=0.020 !Frequency tolerance (kHz) ftol=0.020 !Frequency tolerance (kHz)
foffset=0.001*(1270 + nfcal) foffset=0.001*(1270 + nfcal)
fselect=mfqso + foffset fselect=mfqso + foffset
dphi=idphi/57.2957795 dphi=idphi/57.2957795
do i=12,3,-1 do i=12,3,-1
if(hiscall(i:i).ne.' ') go to 1 if(hiscall(i:i).ne.' ') go to 1
enddo enddo
i=0 i=0
1 len_hiscall=i 1 len_hiscall=i
iloop=0 iloop=0
2 if(ndphi.eq.1) dphi=30*iloop/57.2957795 2 if(ndphi.eq.1) dphi=30*iloop/57.2957795
do nqd=1,0,-1 do nqd=1,0,-1
if(nqd.eq.1) then !Quick decode, at fQSO if(nqd.eq.1) then !Quick decode, at fQSO
fa=1000.0*(fselect+0.001*mousedf-100.0) - dftolerance fa=1000.0*(fselect+0.001*mousedf-100.0) - dftolerance
fb=1000.0*(fselect+0.001*mousedf-100.0) + dftolerance + 4*53.8330078 fb=1000.0*(fselect+0.001*mousedf-100.0) + dftolerance + 4*53.8330078
ia=nint((fa+23000.0)/df + 1.0) ! 23000 = 48000 - 25000 ia=nint((fa+23000.0)/df + 1.0) ! 23000 = 48000 - 25000
ib=nint((fb+23000.0)/df + 1.0) ib=nint((fb+23000.0)/df + 1.0)
else !Wideband decode at all freqs else !Wideband decode at all freqs
fa=1000*(nfa-100) fa=1000*(nfa-100)
fb=1000*(nfb-100) fb=1000*(nfb-100)
ia=nint((fa+23000.0)/df + 1.0) ! 23000 = 48000 - 25000 ia=nint((fa+23000.0)/df + 1.0) ! 23000 = 48000 - 25000
ib=nint((fb+23000.0)/df + 1.0) ib=nint((fb+23000.0)/df + 1.0)
endif endif
km=0 km=0
nkm=1 nkm=1
nz=n/8 nz=n/8
do i=1,NFFT do i=1,NFFT
short(1,i)=0. short(1,i)=0.
short(2,i)=0. short(2,i)=0.
short(3,i)=0. short(3,i)=0.
enddo enddo
freq0=-999. freq0=-999.
sync10=-999. sync10=-999.
fshort0=-999. fshort0=-999.
sync20=-999. sync20=-999.
ntry=0 ntry=0
do i=ia,ib !Search over freq range do i=ia,ib !Search over freq range
call sleep_msec(0) call sleep_msec(0)
freq=0.001*((i-1)*df - 23000) + 100.0 freq=0.001*((i-1)*df - 23000) + 100.0
! Find the local base level for each polarization; update every 10 bins. ! Find the local base level for each polarization; update every 10 bins.
if(mod(i-ia,10).eq.0) then if(mod(i-ia,10).eq.0) then
do jp=1,4 do jp=1,4
do ii=-50,50 do ii=-50,50
iii=i+ii iii=i+ii
if(iii.ge.1 .and. iii.le.32768) then if(iii.ge.1 .and. iii.le.32768) then
tavg(ii)=savg(jp,iii) tavg(ii)=savg(jp,iii)
else else
print*,'Error in iii:',iii,ia,ib,fa,fb print*,'Error in iii:',iii,ia,ib,fa,fb
go to 999 go to 999
endif endif
enddo enddo
call pctile(tavg,tmp,101,50,base(jp)) call pctile(tavg,tmp,101,50,base(jp))
enddo enddo
bmax=max(base(1),base(2),base(3),base(4)) bmax=max(base(1),base(2),base(3),base(4))
endif endif
! Do not process extremely strong signals ! Do not process extremely strong signals
if(nqd.eq.0 .and. bmax.gt.1000.0) go to 70 if(nqd.eq.0 .and. bmax.gt.1000.0) go to 70
! Find max signal at this frequency ! Find max signal at this frequency
smax=0. smax=0.
do jp=1,4 do jp=1,4
if(savg(jp,i)/base(jp).gt.smax) smax=savg(jp,i)/base(jp) if(savg(jp,i)/base(jp).gt.smax) smax=savg(jp,i)/base(jp)
enddo enddo
if(smax.gt.1.1) then if(smax.gt.1.1) then
ntry=ntry+1 ntry=ntry+1
! Look for JT65 sync patterns and shorthand square-wave patterns. ! Look for JT65 sync patterns and shorthand square-wave patterns.
call ccf65(ss(1,1,i),nhsym,sync1,ipol,dt,flipk, & call ccf65(ss(1,1,i),nhsym,sync1,ipol,dt,flipk, &
syncshort,snr2,ipol2,dt2) syncshort,snr2,ipol2,dt2)
! ########################### Search for Shorthand Messages ################# ! ########################### Search for Shorthand Messages #################
! Is there a shorthand tone above threshold? ! Is there a shorthand tone above threshold?
thresh0=1.0 thresh0=1.0
! Use lower thresh0 at fQSO ! Use lower thresh0 at fQSO
if(nqd.eq.1 .and. dftolerance.le.100) thresh0=0. if(nqd.eq.1 .and. dftolerance.le.100) thresh0=0.
if(syncshort.gt.thresh0) then if(syncshort.gt.thresh0) then
! ### Do shorthand AFC here (or maybe after finding a pair?) ### ! ### Do shorthand AFC here (or maybe after finding a pair?) ###
short(1,i)=syncshort short(1,i)=syncshort
short(2,i)=dt2 short(2,i)=dt2
short(3,i)=ipol2 short(3,i)=ipol2
! Check to see if lower tone of shorthand pair was found. ! Check to see if lower tone of shorthand pair was found.
do j=2,4 do j=2,4
i0=i-nint(j*53.8330078/df) i0=i-nint(j*53.8330078/df)
! Should this be i0 +/- 1, or just i0? ! Should this be i0 +/- 1, or just i0?
! Should we also insist that difference in DT be either 1.5 or -1.5 s? ! Should we also insist that difference in DT be either 1.5 or -1.5 s?
if(short(1,i0).gt.1.0) then if(short(1,i0).gt.1.0) then
fshort=0.001*((i0-1)*df - 23000) + 100.0 fshort=0.001*((i0-1)*df - 23000) + 100.0
noffset=0 noffset=0
if(nqd.eq.1) noffset=nint(1000.0* & if(nqd.eq.1) noffset=nint(1000.0* &
(fshort-foffset-mfqso)-mousedf) (fshort-foffset-mfqso)-mousedf)
if(abs(noffset).le.dftolerance) then if(abs(noffset).le.dftolerance) then
! Keep only the best candidate within ftol. ! Keep only the best candidate within ftol.
!### NB: sync2 was not defined here! !### NB: sync2 was not defined here!
sync2=syncshort !### try this ??? sync2=syncshort !### try this ???
if(fshort-fshort0.le.ftol .and. sync2.gt.sync20 & if(fshort-fshort0.le.ftol .and. sync2.gt.sync20 &
.and. nkm.eq.2) km=km-1 .and. nkm.eq.2) km=km-1
if(fshort-fshort0.gt.ftol .or. & if(fshort-fshort0.gt.ftol .or. &
sync2.gt.sync20) then sync2.gt.sync20) then
km=km+1 km=km+1
sig(km,1)=nfile sig(km,1)=nfile
sig(km,2)=nutc sig(km,2)=nutc
sig(km,3)=fshort sig(km,3)=fshort
sig(km,4)=syncshort sig(km,4)=syncshort
sig(km,5)=dt2 sig(km,5)=dt2
sig(km,6)=45*(ipol2-1)/57.2957795 sig(km,6)=45*(ipol2-1)/57.2957795
sig(km,7)=0 sig(km,7)=0
sig(km,8)=snr2 sig(km,8)=snr2
sig(km,9)=0 sig(km,9)=0
sig(km,10)=0 sig(km,10)=0
! sig(km,11)=rms0 ! sig(km,11)=rms0
sig(km,12)=savg(ipol2,i) sig(km,12)=savg(ipol2,i)
sig(km,13)=0 sig(km,13)=0
sig(km,14)=0 sig(km,14)=0
sig(km,15)=0 sig(km,15)=0
sig(km,16)=0 sig(km,16)=0
! sig(km,17)=0 ! sig(km,17)=0
sig(km,18)=0 sig(km,18)=0
msg(km)=shmsg0(j) msg(km)=shmsg0(j)
fshort0=fshort fshort0=fshort
sync20=sync2 sync20=sync2
nkm=2 nkm=2
endif endif
endif endif
endif endif
enddo enddo
endif endif
! ########################### Search for Normal Messages ########### ! ########################### Search for Normal Messages ###########
! Is sync1 above threshold? ! Is sync1 above threshold?
thresh1=1.0 thresh1=1.0
! Use lower thresh1 at fQSO ! Use lower thresh1 at fQSO
if(nqd.eq.1 .and. dftolerance.le.100) thresh1=0. if(nqd.eq.1 .and. dftolerance.le.100) thresh1=0.
noffset=0 noffset=0
if(nqd.eq.1) noffset=nint(1000.0*(freq-foffset-mfqso)-mousedf) if(nqd.eq.1) noffset=nint(1000.0*(freq-foffset-mfqso)-mousedf)
if(sync1.gt.thresh1 .and. abs(noffset).le.dftolerance) then if(sync1.gt.thresh1 .and. abs(noffset).le.dftolerance) then
! Keep only the best candidate within ftol. ! Keep only the best candidate within ftol.
! (Am I deleting any good decodes by doing this?) ! (Am I deleting any good decodes by doing this?)
if(freq-freq0.le.ftol .and. sync1.gt.sync10 .and. & if(freq-freq0.le.ftol .and. sync1.gt.sync10 .and. &
nkm.eq.1) km=km-1 nkm.eq.1) km=km-1
if(freq-freq0.gt.ftol .or. sync1.gt.sync10) then if(freq-freq0.gt.ftol .or. sync1.gt.sync10) then
nflip=nint(flipk) nflip=nint(flipk)
call decode1a(id(1,1,kbuf),newdat,freq,nflip, & call decode1a(id(1,1,kbuf),newdat,freq,nflip, &
mycall,hiscall,hisgrid,neme,ndepth,nqd,dphi,ndphi, & mycall,hiscall,hisgrid,neme,ndepth,nqd,dphi,ndphi, &
ipol,sync2,a,dt,pol,nkv,nhist,qual,decoded) ipol,sync2,a,dt,pol,nkv,nhist,qual,decoded)
! If hiscall or hisgrid is in decoded message, save the pol'n angle. ! If hiscall or hisgrid is in decoded message, save the pol'n angle.
i1=index(decoded,hiscall(1:len_hiscall)) i1=index(decoded,hiscall(1:len_hiscall))
i2=index(decoded,hisgrid(1:4)) i2=index(decoded,hisgrid(1:4))
if(i1.ge.5 .or. i2.ge.9) then if(i1.ge.5 .or. i2.ge.9) then
nhispol=nint(57.2957795*pol) nhispol=nint(57.2957795*pol)
endif endif
km=km+1 km=km+1
sig(km,1)=nfile sig(km,1)=nfile
sig(km,2)=nutc sig(km,2)=nutc
sig(km,3)=freq sig(km,3)=freq
sig(km,4)=sync1 sig(km,4)=sync1
sig(km,5)=dt sig(km,5)=dt
sig(km,6)=pol sig(km,6)=pol
sig(km,7)=flipk sig(km,7)=flipk
sig(km,8)=sync2 sig(km,8)=sync2
sig(km,9)=nkv sig(km,9)=nkv
sig(km,10)=qual sig(km,10)=qual
! sig(km,11)=idphi ! sig(km,11)=idphi
sig(km,12)=savg(ipol,i) sig(km,12)=savg(ipol,i)
sig(km,13)=a(1) sig(km,13)=a(1)
sig(km,14)=a(2) sig(km,14)=a(2)
sig(km,15)=a(3) sig(km,15)=a(3)
sig(km,16)=a(4) sig(km,16)=a(4)
! sig(km,17)=a(5) ! sig(km,17)=a(5)
sig(km,18)=nhist sig(km,18)=nhist
msg(km)=decoded msg(km)=decoded
freq0=freq freq0=freq
sync10=sync1 sync10=sync1
nkm=1 nkm=1
endif endif
endif endif
endif endif
70 continue 70 continue
enddo enddo
if(nqd.eq.1) then if(nqd.eq.1) then
nwrite=0 nwrite=0
do k=1,km do k=1,km
decoded=msg(k) decoded=msg(k)
if(decoded.ne.' ') then if(decoded.ne.' ') then
nutc=sig(k,2) nutc=sig(k,2)
freq=sig(k,3) freq=sig(k,3)
sync1=sig(k,4) sync1=sig(k,4)
dt=sig(k,5) dt=sig(k,5)
npol=nint(57.2957795*sig(k,6)) npol=nint(57.2957795*sig(k,6))
flip=sig(k,7) flip=sig(k,7)
sync2=sig(k,8) sync2=sig(k,8)
nkv=sig(k,9) nkv=sig(k,9)
nqual=sig(k,10) nqual=sig(k,10)
! idphi=nint(sig(k,11)) ! idphi=nint(sig(k,11))
if(flip.lt.0.0) then if(flip.lt.0.0) then
do i=22,1,-1 do i=22,1,-1
if(decoded(i:i).ne.' ') go to 8 if(decoded(i:i).ne.' ') go to 8
enddo enddo
stop 'Error in message format' stop 'Error in message format'
8 if(i.le.18) decoded(i+2:i+4)='OOO' 8 if(i.le.18) decoded(i+2:i+4)='OOO'
endif endif
nkHz=nint(freq-foffset) + nfoffset nkHz=nint(freq-foffset) + nfoffset
f0=144.0+0.001*nkHz f0=144.0+0.001*nkHz
ndf=nint(1000.0*(freq-foffset-nkHz+nfoffset)) ndf=nint(1000.0*(freq-foffset-nkHz+nfoffset))
! ndf0=nint(a(1)) ! ndf0=nint(a(1))
! ndf1=nint(a(2)) ! ndf1=nint(a(2))
! ndf2=nint(a(3)) ! ndf2=nint(a(3))
nsync1=sync1 nsync1=sync1
nsync2=nint(10.0*log10(sync2)) - 40 !### empirical ### nsync2=nint(10.0*log10(sync2)) - 40 !### empirical ###
if(decoded(1:4).eq.'RO ' .or. decoded(1:4).eq.'RRR ' .or. & if(decoded(1:4).eq.'RO ' .or. decoded(1:4).eq.'RRR ' .or. &
decoded(1:4).eq.'73 ') nsync2=nsync2-6 decoded(1:4).eq.'73 ') nsync2=nsync2-6
nwrite=nwrite+1 nwrite=nwrite+1
if(ndphi.eq.0) then if(ndphi.eq.0) then
write(11,1010) nkHz,ndf,npol,nutc,dt,nsync2,decoded,nkv,nqual write(11,1010) nkHz,ndf,npol,nutc,dt,nsync2,decoded,nkv,nqual
1010 format(i3,i5,i4,i5.4,f5.1,i4,2x,a22,i5,i4,i4) 1010 format(i3,i5,i4,i5.4,f5.1,i4,2x,a22,i5,i4,i4)
else else
if(iloop.ge.1) qphi(iloop)=sig(k,10) if(iloop.ge.1) qphi(iloop)=sig(k,10)
write(11,1010) nkHz,ndf,npol,nutc,dt,nsync2,decoded,nkv, & write(11,1010) nkHz,ndf,npol,nutc,dt,nsync2,decoded,nkv, &
nqual,30*iloop nqual,30*iloop
write(27,1011) 30*iloop,nkHz,ndf,npol,nutc, & write(27,1011) 30*iloop,nkHz,ndf,npol,nutc, &
dt,sync2,nkv,nqual,decoded dt,sync2,nkv,nqual,decoded
1011 format(i3,i4,i5,i4,i5.4,f5.1,f7.1,i3,i5,2x,a22) 1011 format(i3,i4,i5,i4,i5.4,f5.1,f7.1,i3,i5,2x,a22)
endif endif
endif endif
enddo enddo
if(nwrite.eq.0) then if(nwrite.eq.0) then
nfqso=mfqso + nfoffset nfqso=mfqso + nfoffset
write(11,1012) nfqso,nutc write(11,1012) nfqso,nutc
1012 format(i3,9x,i5.4) 1012 format(i3,9x,i5.4)
endif endif
endif endif
if(ndphi.eq.1 .and.iloop.lt.12) then if(ndphi.eq.1 .and.iloop.lt.12) then
iloop=iloop+1 iloop=iloop+1
go to 2 go to 2
endif endif
if(ndphi.eq.1 .and.iloop.eq.12) call getdphi(qphi) if(ndphi.eq.1 .and.iloop.eq.12) call getdphi(qphi)
if(nqd.eq.1) then if(nqd.eq.1) then
write(11,*) '$EOF' write(11,*) '$EOF'
call flushqqq(11) call flushqqq(11)
ndecdone=1 ndecdone=1
endif endif
if(nagain.eq.1) go to 999 if(nagain.eq.1) go to 999
enddo enddo
! Trim the list and produce a sorted index and sizes of groups. ! Trim the list and produce a sorted index and sizes of groups.
! (Should trimlist remove all but best SNR for given UTC and message content?) ! (Should trimlist remove all but best SNR for given UTC and message content?)
call trimlist(sig,km,indx,nsiz,nz) call trimlist(sig,km,indx,nsiz,nz)
do i=1,km do i=1,km
done(i)=.false. done(i)=.false.
enddo enddo
j=0 j=0
ilatest=-1 ilatest=-1
do n=1,nz do n=1,nz
ifile0=0 ifile0=0
do m=1,nsiz(n) do m=1,nsiz(n)
i=indx(j+m) i=indx(j+m)
ifile=sig(i,1) ifile=sig(i,1)
if(ifile.gt.ifile0 .and.msg(i).ne.blank) then if(ifile.gt.ifile0 .and.msg(i).ne.blank) then
ilatest=i ilatest=i
ifile0=ifile ifile0=ifile
endif endif
enddo enddo
i=ilatest i=ilatest
if(i.ge.1) then if(i.ge.1) then
if(.not.done(i)) then if(.not.done(i)) then
done(i)=.true. done(i)=.true.
nutc=sig(i,2) nutc=sig(i,2)
freq=sig(i,3) freq=sig(i,3)
sync1=sig(i,4) sync1=sig(i,4)
dt=sig(i,5) dt=sig(i,5)
npol=nint(57.2957795*sig(i,6)) npol=nint(57.2957795*sig(i,6))
flip=sig(i,7) flip=sig(i,7)
sync2=sig(i,8) sync2=sig(i,8)
nkv=sig(i,9) nkv=sig(i,9)
nqual=min(sig(i,10),10.0) nqual=min(sig(i,10),10.0)
! rms0=sig(i,11) ! rms0=sig(i,11)
do k=1,5 do k=1,5
a(k)=sig(i,12+k) a(k)=sig(i,12+k)
enddo enddo
nhist=sig(i,18) nhist=sig(i,18)
decoded=msg(i) decoded=msg(i)
if(flip.lt.0.0) then if(flip.lt.0.0) then
do i=22,1,-1 do i=22,1,-1
if(decoded(i:i).ne.' ') go to 10 if(decoded(i:i).ne.' ') go to 10
enddo enddo
stop 'Error in message format' stop 'Error in message format'
10 if(i.le.18) decoded(i+2:i+4)='OOO' 10 if(i.le.18) decoded(i+2:i+4)='OOO'
endif endif
nkHz=nint(freq-foffset) + nfoffset nkHz=nint(freq-foffset) + nfoffset
f0=144.0+0.001*nkHz f0=144.0+0.001*nkHz
ndf=nint(1000.0*(freq-foffset-nkHz+nfoffset)) ndf=nint(1000.0*(freq-foffset-nkHz+nfoffset))
ndf0=nint(a(1)) ndf0=nint(a(1))
ndf1=nint(a(2)) ndf1=nint(a(2))
ndf2=nint(a(3)) ndf2=nint(a(3))
nsync1=sync1 nsync1=sync1
nsync2=nint(10.0*log10(sync2)) - 40 !### empirical ### nsync2=nint(10.0*log10(sync2)) - 40 !### empirical ###
if(decoded(1:4).eq.'RO ' .or. decoded(1:4).eq.'RRR ' .or. & if(decoded(1:4).eq.'RO ' .or. decoded(1:4).eq.'RRR ' .or. &
decoded(1:4).eq.'73 ') nsync2=nsync2-6 decoded(1:4).eq.'73 ') nsync2=nsync2-6
write(26,1014) f0,ndf,ndf0,ndf1,ndf2,dt,npol,nsync1, & write(26,1014) f0,ndf,ndf0,ndf1,ndf2,dt,npol,nsync1, &
nsync2,nutc,decoded,nkv,nqual,nhist nsync2,nutc,decoded,nkv,nqual,nhist
write(21,1014) f0,ndf,ndf0,ndf1,ndf2,dt,npol,nsync1, & write(21,1014) f0,ndf,ndf0,ndf1,ndf2,dt,npol,nsync1, &
nsync2,nutc,decoded,nkv,nqual,nhist nsync2,nutc,decoded,nkv,nqual,nhist
1014 format(f7.3,i5,3i3,f5.1,i5,i3,i4,i5.4,2x,a22,3i3) 1014 format(f7.3,i5,3i3,f5.1,i5,i3,i4,i5.4,2x,a22,3i3)
endif endif
endif endif
j=j+nsiz(n) j=j+nsiz(n)
enddo enddo
write(26,1015) nutc write(26,1015) nutc
1015 format(39x,i4.4) 1015 format(39x,i4.4)
call flushqqq(26) call flushqqq(26)
call display(nkeep,ncsmin) call display(nkeep,ncsmin)
ndecdone=2 ndecdone=2
if(nsave.gt.0 .and. ndiskdat.eq.0) call savetf2(id(1,1,kbuf), & if(nsave.gt.0 .and. ndiskdat.eq.0) call savetf2(id(1,1,kbuf), &
fnamedate,savedir) fnamedate,savedir)
999 close(23) 999 close(23)
ndphi=0 ndphi=0
if(kbuf.eq.1) kkdone=60*96000 if(kbuf.eq.1) kkdone=60*96000
if(kbuf.eq.2 .or. ndiskdat.eq.1) kkdone=0 if(kbuf.eq.2 .or. ndiskdat.eq.1) kkdone=0
kk=kkdone kk=kkdone
nagain=0 nagain=0
return return
end subroutine map65a end subroutine map65a

56
pix2d65.f90
View File

@ -1,28 +1,28 @@
subroutine pix2d65(d2,jz) subroutine pix2d65(d2,jz)
! Compute data for green line in JT65 mode. ! Compute data for green line in JT65 mode.
integer*2 d2(jz) !Raw input data integer*2 d2(jz) !Raw input data
include 'gcom2.f90' include 'gcom2.f90'
sum=0. sum=0.
do i=1,jz do i=1,jz
sum=sum+d2(i) sum=sum+d2(i)
enddo enddo
nave=nint(sum/jz) nave=nint(sum/jz)
nadd=nint(53.0*11025.0/500.0) nadd=nint(53.0*11025.0/500.0)
ngreen=min(jz/nadd,500) ngreen=min(jz/nadd,500)
k=0 k=0
do i=1,ngreen do i=1,ngreen
sq=0. sq=0.
do n=1,nadd do n=1,nadd
k=k+1 k=k+1
d2(k)=d2(k)-nave d2(k)=d2(k)-nave
x=d2(k) x=d2(k)
sq=sq + x*x sq=sq + x*x
enddo enddo
green(i)=db(sq)-96.0 green(i)=db(sq)-96.0
enddo enddo
return return
end subroutine pix2d65 end subroutine pix2d65

134
plrr_subs.c
View File

@ -1,67 +1,67 @@
/* The following don't seem to be needed? #include <sys/types.h>
#include <sys/types.h> #include <sys/socket.h>
#include <sys/socket.h> #include <netinet/in.h>
#include <netinet/in.h> /* The following don't seem to be needed?
#include <time.h> #include <time.h>
#include <stdio.h> #include <stdio.h>
*/ */
#include <arpa/inet.h> #include <arpa/inet.h>
#include <string.h> #include <string.h>
#include <stdlib.h> #include <stdlib.h>
#define HELLO_PORT 50004 #define HELLO_PORT 50004
#define HELLO_GROUP "239.255.0.0" #define HELLO_GROUP "239.255.0.0"
#define MSGBUFSIZE 1416 #define MSGBUFSIZE 1416
struct sockaddr_in addr; struct sockaddr_in addr;
int fd; int fd;
void setup_rsocket_(void) void setup_rsocket_(void)
{ {
struct ip_mreq mreq; struct ip_mreq mreq;
u_int yes=1; u_int yes=1;
/* create what looks like an ordinary UDP socket */ /* create what looks like an ordinary UDP socket */
if ((fd=socket(AF_INET,SOCK_DGRAM,0)) < 0) { if ((fd=socket(AF_INET,SOCK_DGRAM,0)) < 0) {
perror("socket"); perror("socket");
exit(1); exit(1);
} }
/* allow multiple sockets to use the same PORT number */ /* allow multiple sockets to use the same PORT number */
if (setsockopt(fd,SOL_SOCKET,SO_REUSEADDR,&yes,sizeof(yes)) < 0) { if (setsockopt(fd,SOL_SOCKET,SO_REUSEADDR,&yes,sizeof(yes)) < 0) {
perror("Reusing ADDR failed"); perror("Reusing ADDR failed");
exit(1); exit(1);
} }
/* set up destination address */ /* set up destination address */
memset(&addr,0,sizeof(addr)); memset(&addr,0,sizeof(addr));
addr.sin_family=AF_INET; addr.sin_family=AF_INET;
addr.sin_addr.s_addr=htonl(INADDR_ANY); /* N.B.: differs from sender */ addr.sin_addr.s_addr=htonl(INADDR_ANY); /* N.B.: differs from sender */
addr.sin_port=htons(HELLO_PORT); addr.sin_port=htons(HELLO_PORT);
/* bind to receive address */ /* bind to receive address */
if (bind(fd,(struct sockaddr *) &addr,sizeof(addr)) < 0) { if (bind(fd,(struct sockaddr *) &addr,sizeof(addr)) < 0) {
perror("bind"); perror("bind");
exit(1); exit(1);
} }
/* use setsockopt() to request that the kernel join a multicast group */ /* use setsockopt() to request that the kernel join a multicast group */
mreq.imr_multiaddr.s_addr=inet_addr(HELLO_GROUP); mreq.imr_multiaddr.s_addr=inet_addr(HELLO_GROUP);
mreq.imr_interface.s_addr=htonl(INADDR_ANY); mreq.imr_interface.s_addr=htonl(INADDR_ANY);
if (setsockopt(fd,IPPROTO_IP,IP_ADD_MEMBERSHIP,&mreq,sizeof(mreq)) < 0) { if (setsockopt(fd,IPPROTO_IP,IP_ADD_MEMBERSHIP,&mreq,sizeof(mreq)) < 0) {
perror("setsockopt"); perror("setsockopt");
exit(1); exit(1);
} }
} }
void recv_pkt_(char buf[]) void recv_pkt_(char buf[])
{ {
int addrlen,nbytes; int addrlen,nbytes;
addrlen=sizeof(addr); addrlen=sizeof(addr);
if ((nbytes=recvfrom(fd,buf,1416,0, if ((nbytes=recvfrom(fd,buf,1416,0,
(struct sockaddr *) &addr,&addrlen)) < 0) { (struct sockaddr *) &addr,&addrlen)) < 0) {
perror("recvfrom"); perror("recvfrom");
exit(1); exit(1);
} }
} }

214
plrr_subs_win.c
View File

@ -1,107 +1,107 @@
#include <winsock2.h> #include <winsock2.h>
#include <ws2tcpip.h> #include <ws2tcpip.h>
#include <stdlib.h> #include <stdlib.h>
#include <stdio.h> #include <stdio.h>
#define HELLO_PORT 50004 #define HELLO_PORT 50004
#define HELLO_GROUP "239.255.0.0" #define HELLO_GROUP "239.255.0.0"
#define MSGBUFSIZE 1416 #define MSGBUFSIZE 1416
struct sockaddr_in addr; struct sockaddr_in addr;
int fd; int fd;
//void __stdcall SETUP_RSOCKET(void) //void __stdcall SETUP_RSOCKET(void)
void setup_rsocket_(int *multicast0) void setup_rsocket_(int *multicast0)
{ {
struct ip_mreq mreq; struct ip_mreq mreq;
u_int yes=1; u_int yes=1;
int i,j,k; int i,j,k;
// Make sure that we have compatible Winsock support // Make sure that we have compatible Winsock support
WORD wVersionRequested; WORD wVersionRequested;
WSADATA wsaData; WSADATA wsaData;
int err; int err;
wVersionRequested = MAKEWORD( 2, 2 ); wVersionRequested = MAKEWORD( 2, 2 );
err = WSAStartup( wVersionRequested, &wsaData ); err = WSAStartup( wVersionRequested, &wsaData );
if ( err != 0 ) { if ( err != 0 ) {
/* Tell the user that we could not find a usable */ /* Tell the user that we could not find a usable */
/* WinSock DLL. */ /* WinSock DLL. */
exit(1); exit(1);
} }
/* Confirm that the WinSock DLL supports 2.2.*/ /* Confirm that the WinSock DLL supports 2.2.*/
/* Note that if the DLL supports versions greater */ /* Note that if the DLL supports versions greater */
/* than 2.2 in addition to 2.2, it will still return */ /* than 2.2 in addition to 2.2, it will still return */
/* 2.2 in wVersion since that is the version we */ /* 2.2 in wVersion since that is the version we */
/* requested. */ /* requested. */
if ( LOBYTE( wsaData.wVersion ) != 2 || if ( LOBYTE( wsaData.wVersion ) != 2 ||
HIBYTE( wsaData.wVersion ) != 2 ) { HIBYTE( wsaData.wVersion ) != 2 ) {
/* Tell the user that we could not find a usable */ /* Tell the user that we could not find a usable */
/* WinSock DLL. */ /* WinSock DLL. */
WSACleanup( ); WSACleanup( );
exit(1); exit(1);
} }
/* The WinSock DLL is acceptable. Proceed. */ /* The WinSock DLL is acceptable. Proceed. */
/* create what looks like an ordinary UDP socket */ /* create what looks like an ordinary UDP socket */
if ((fd=socket(AF_INET,SOCK_DGRAM,IPPROTO_UDP)) < 0) { if ((fd=socket(AF_INET,SOCK_DGRAM,IPPROTO_UDP)) < 0) {
perror("socket"); perror("socket");
exit(1); exit(1);
} }
k=sizeof(int); k=sizeof(int);
i=256*1024; i=256*1024;
err=setsockopt(fd, SOL_SOCKET, SO_RCVBUF, (char *)&i,k); err=setsockopt(fd, SOL_SOCKET, SO_RCVBUF, (char *)&i,k);
if (err<0) { if (err<0) {
j=WSAGetLastError(); j=WSAGetLastError();
printf("Error: %d %d\n",err,j); printf("Error: %d %d\n",err,j);
} }
if (*multicast0) { if (*multicast0) {
// allow multiple sockets to use the same PORT number // allow multiple sockets to use the same PORT number
if (setsockopt(fd,SOL_SOCKET,SO_REUSEADDR,&yes,sizeof(yes)) < 0) { if (setsockopt(fd,SOL_SOCKET,SO_REUSEADDR,&yes,sizeof(yes)) < 0) {
perror("Reusing ADDR failed"); perror("Reusing ADDR failed");
exit(1); exit(1);
} }
printf("Accepting multicast data from Linrad.\n"); printf("Accepting multicast data from Linrad.\n");
} }
else { else {
printf("Accepting unicast data from Linrad.\n"); printf("Accepting unicast data from Linrad.\n");
} }
/* set up destination address */ /* set up destination address */
memset(&addr,0,sizeof(addr)); memset(&addr,0,sizeof(addr));
addr.sin_family=AF_INET; addr.sin_family=AF_INET;
addr.sin_addr.s_addr=htonl(INADDR_ANY); addr.sin_addr.s_addr=htonl(INADDR_ANY);
addr.sin_port=htons(HELLO_PORT); addr.sin_port=htons(HELLO_PORT);
/* Bind socket to a local source port */ /* Bind socket to a local source port */
if (bind(fd,(struct sockaddr *) &addr,sizeof(addr)) < 0) { if (bind(fd,(struct sockaddr *) &addr,sizeof(addr)) < 0) {
perror("bind"); perror("bind");
exit(1); exit(1);
} }
if (*multicast0) { if (*multicast0) {
// use setsockopt() to request that the kernel join a multicast group // use setsockopt() to request that the kernel join a multicast group
mreq.imr_multiaddr.s_addr=inet_addr(HELLO_GROUP); mreq.imr_multiaddr.s_addr=inet_addr(HELLO_GROUP);
mreq.imr_interface.s_addr=htonl(INADDR_ANY); mreq.imr_interface.s_addr=htonl(INADDR_ANY);
// NG: mreq.imr_interface.s_addr=htonl("192.168.10.13"); // NG: mreq.imr_interface.s_addr=htonl("192.168.10.13");
if (setsockopt(fd,IPPROTO_IP,IP_ADD_MEMBERSHIP,&mreq,sizeof(mreq)) < 0) { if (setsockopt(fd,IPPROTO_IP,IP_ADD_MEMBERSHIP,&mreq,sizeof(mreq)) < 0) {
perror("setsockopt"); perror("setsockopt");
exit(1); exit(1);
} }
} }
} }
//void __stdcall RECV_PKT(char buf[]) //void __stdcall RECV_PKT(char buf[])
void recv_pkt_(char buf[]) void recv_pkt_(char buf[])
{ {
int addrlen,nbytes; int addrlen,nbytes;
addrlen=sizeof(addr); addrlen=sizeof(addr);
if ((nbytes=recvfrom(fd,buf,1416,0, if ((nbytes=recvfrom(fd,buf,1416,0,
(struct sockaddr *) &addr,&addrlen)) < 0) { (struct sockaddr *) &addr,&addrlen)) < 0) {
perror("recvfrom"); perror("recvfrom");
exit(1); exit(1);
} }
} }

82
plrs_subs.c
View File

@ -1,42 +1,40 @@
/* The following don't seem to be needed? #include <sys/types.h>
#include <sys/types.h> #include <sys/socket.h>
#include <sys/socket.h> #include <netinet/in.h>
#include <netinet/in.h> #include <time.h>
#include <time.h> #include <stdio.h>
#include <stdio.h>
*/ #include <arpa/inet.h>
#include <string.h>
#include <arpa/inet.h> #include <stdlib.h>
#include <string.h>
#include <stdlib.h> #define HELLO_PORT 50004
#define HELLO_GROUP "239.255.0.0"
#define HELLO_PORT 50004
#define HELLO_GROUP "239.255.0.0" struct sockaddr_in addr;
int fd;
struct sockaddr_in addr;
int fd; void setup_ssocket_(void)
{
void setup_ssocket_(void) struct ip_mreq mreq;
{
struct ip_mreq mreq; /* create what looks like an ordinary UDP socket */
if ((fd=socket(AF_INET,SOCK_DGRAM,0)) < 0) {
/* create what looks like an ordinary UDP socket */ perror("socket");
if ((fd=socket(AF_INET,SOCK_DGRAM,0)) < 0) { exit(EXIT_FAILURE);
perror("socket"); }
exit(EXIT_FAILURE);
} /* set up destination address */
memset(&addr,0,sizeof(addr));
/* set up destination address */ addr.sin_family=AF_INET;
memset(&addr,0,sizeof(addr)); addr.sin_addr.s_addr=inet_addr(HELLO_GROUP);
addr.sin_family=AF_INET; addr.sin_port=htons(HELLO_PORT);
addr.sin_addr.s_addr=inet_addr(HELLO_GROUP); }
addr.sin_port=htons(HELLO_PORT);
} void send_pkt_(char buf[])
{
void send_pkt_(char buf[]) if (sendto(fd,buf,1416,0,(struct sockaddr *) &addr,
{ sizeof(addr)) < 0) {
if (sendto(fd,buf,1416,0,(struct sockaddr *) &addr, perror("sendto");
sizeof(addr)) < 0) { exit(EXIT_FAILURE);}
perror("sendto"); }
exit(EXIT_FAILURE);}
}

128
plrs_subs_win.c
View File

@ -1,64 +1,64 @@
#include <winsock2.h> #include <winsock2.h>
#include <ws2tcpip.h> #include <ws2tcpip.h>
#include <stdlib.h> #include <stdlib.h>
#include <stdio.h> #include <stdio.h>
#define HELLO_PORT 50004 #define HELLO_PORT 50004
//#define HELLO_GROUP "239.255.0.0" //#define HELLO_GROUP "239.255.0.0"
#define HELLO_GROUP "127.0.0.1" #define HELLO_GROUP "127.0.0.1"
struct sockaddr_in addr; struct sockaddr_in addr;
int fd; int fd;
void __stdcall SETUP_SSOCKET(void) void __stdcall SETUP_SSOCKET(void)
{ {
struct ip_mreq mreq; struct ip_mreq mreq;
// Make sure that we have compatible Winsock support // Make sure that we have compatible Winsock support
WORD wVersionRequested; WORD wVersionRequested;
WSADATA wsaData; WSADATA wsaData;
int err; int err;
wVersionRequested = MAKEWORD( 2, 2 ); wVersionRequested = MAKEWORD( 2, 2 );
err = WSAStartup( wVersionRequested, &wsaData ); err = WSAStartup( wVersionRequested, &wsaData );
if ( err != 0 ) { if ( err != 0 ) {
/* Tell the user that we could not find a usable */ /* Tell the user that we could not find a usable */
/* WinSock DLL. */ /* WinSock DLL. */
exit(1); exit(1);
} }
/* Confirm that the WinSock DLL supports 2.2.*/ /* Confirm that the WinSock DLL supports 2.2.*/
/* Note that if the DLL supports versions greater */ /* Note that if the DLL supports versions greater */
/* than 2.2 in addition to 2.2, it will still return */ /* than 2.2 in addition to 2.2, it will still return */
/* 2.2 in wVersion since that is the version we */ /* 2.2 in wVersion since that is the version we */
/* requested. */ /* requested. */
if ( LOBYTE( wsaData.wVersion ) != 2 || if ( LOBYTE( wsaData.wVersion ) != 2 ||
HIBYTE( wsaData.wVersion ) != 2 ) { HIBYTE( wsaData.wVersion ) != 2 ) {
/* Tell the user that we could not find a usable */ /* Tell the user that we could not find a usable */
/* WinSock DLL. */ /* WinSock DLL. */
WSACleanup( ); WSACleanup( );
exit(1); exit(1);
} }
/* The WinSock DLL is acceptable. Proceed. */ /* The WinSock DLL is acceptable. Proceed. */
/* create what looks like an ordinary UDP socket */ /* create what looks like an ordinary UDP socket */
if ((fd=socket(AF_INET,SOCK_DGRAM,IPPROTO_UDP)) < 0) { if ((fd=socket(AF_INET,SOCK_DGRAM,IPPROTO_UDP)) < 0) {
perror("socket"); perror("socket");
exit(1); exit(1);
} }
/* set up destination address */ /* set up destination address */
memset(&addr,0,sizeof(addr)); memset(&addr,0,sizeof(addr));
addr.sin_family=AF_INET; addr.sin_family=AF_INET;
addr.sin_addr.s_addr=inet_addr(HELLO_GROUP); addr.sin_addr.s_addr=inet_addr(HELLO_GROUP);
addr.sin_port=htons(HELLO_PORT); addr.sin_port=htons(HELLO_PORT);
} }
void __stdcall SEND_PKT(char buf[]) void __stdcall SEND_PKT(char buf[])
{ {
if (sendto(fd,buf,1416,0, if (sendto(fd,buf,1416,0,
(struct sockaddr *) &addr, sizeof(addr)) < 0) { (struct sockaddr *) &addr, sizeof(addr)) < 0) {
perror("sendto"); perror("sendto");
exit(1);} exit(1);}
} }

272
recvpkt.F90
View File

@ -1,136 +1,136 @@
subroutine recvpkt(iarg) subroutine recvpkt(iarg)
! Receive timf2 packets from Linrad and stuff data into array id(). ! Receive timf2 packets from Linrad and stuff data into array id().
! (This routine runs in a background thread and will never return.) ! (This routine runs in a background thread and will never return.)
parameter (NSZ=2*60*96000) parameter (NSZ=2*60*96000)
real*8 d8(NSZ) real*8 d8(NSZ)
integer*1 userx_no,iusb integer*1 userx_no,iusb
integer*2 nblock,nblock0 integer*2 nblock,nblock0
logical synced logical synced
real*8 center_freq,buf8 real*8 center_freq,buf8
common/plrscom/center_freq,msec,fqso,iptr,nblock,userx_no,iusb,buf8(174) common/plrscom/center_freq,msec,fqso,iptr,nblock,userx_no,iusb,buf8(174)
include 'datcom.f90' include 'datcom.f90'
include 'gcom1.f90' include 'gcom1.f90'
include 'gcom2.f90' include 'gcom2.f90'
equivalence (id,d8) equivalence (id,d8)
data nblock0/0/,kb/1/,ns00/99/ data nblock0/0/,kb/1/,ns00/99/
data sqave/0.0/,u/0.001/,rxnoise/0.0/,pctblank/0.0/,kbuf/1/,lost_tot/0/ data sqave/0.0/,u/0.001/,rxnoise/0.0/,pctblank/0.0/,kbuf/1/,lost_tot/0/
data multicast0/-99/ data multicast0/-99/
save save
1 call setup_rsocket(multicast) !Open socket for multicast/unicast data 1 call setup_rsocket(multicast) !Open socket for multicast/unicast data
k=0 k=0
kk=0 kk=0
kxp=0 kxp=0
kb=1 kb=1
nsec0=-999 nsec0=-999
fcenter=144.125 !Default (startup) frequency) fcenter=144.125 !Default (startup) frequency)
multicast0=multicast multicast0=multicast
ntx=0 ntx=0
synced=.false. synced=.false.
10 if(multicast.ne.multicast0) go to 1 10 if(multicast.ne.multicast0) go to 1
call recv_pkt(center_freq) call recv_pkt(center_freq)
! Should receive a new packet every 174/96000 = 0.0018125 s ! Should receive a new packet every 174/96000 = 0.0018125 s
nsec=mod(Tsec,86400.d0) !Time according to MAP65 nsec=mod(Tsec,86400.d0) !Time according to MAP65
nseclr=msec/1000 !Time according to Linrad nseclr=msec/1000 !Time according to Linrad
fcenter=center_freq fcenter=center_freq
! Reset buffer pointers at start of minute. ! Reset buffer pointers at start of minute.
ns=mod(nsec,60) ns=mod(nsec,60)
if(ns.lt.ns00 .and. (lauto+monitoring.ne.0)) then if(ns.lt.ns00 .and. (lauto+monitoring.ne.0)) then
! print*,'new minute:',mod(nsec/60,60),ns00,ns,ntx,kb ! print*,'new minute:',mod(nsec/60,60),ns00,ns,ntx,kb
if(ntx.eq.0) kb=3-kb if(ntx.eq.0) kb=3-kb
k=(kb-1)*60*96000 k=(kb-1)*60*96000
kxp=k kxp=k
ndone1=0 ndone1=0
ndone2=0 ndone2=0
lost_tot=0 lost_tot=0
synced=.true. synced=.true.
ntx=0 ntx=0
endif endif
ns00=ns ns00=ns
if(transmitting.eq.1) ntx=1 if(transmitting.eq.1) ntx=1
! Test for buffer full ! Test for buffer full
if((kb.eq.1 .and. (k+174).gt.NSMAX) .or. & if((kb.eq.1 .and. (k+174).gt.NSMAX) .or. &
(kb.eq.2 .and. (k+174).gt.2*NSMAX)) go to 20 (kb.eq.2 .and. (k+174).gt.2*NSMAX)) go to 20
! Check for lost packets ! Check for lost packets
lost=nblock-nblock0-1 lost=nblock-nblock0-1
if(lost.ne.0) then if(lost.ne.0) then
nb=nblock nb=nblock
if(nb.lt.0) nb=nb+65536 if(nb.lt.0) nb=nb+65536
nb0=nblock0 nb0=nblock0
if(nb0.lt.0) nb0=nb0+65536 if(nb0.lt.0) nb0=nb0+65536
lost_tot=lost_tot + lost ! Insert zeros for the lost data. lost_tot=lost_tot + lost ! Insert zeros for the lost data.
do i=1,174*lost do i=1,174*lost
k=k+1 k=k+1
d8(k)=0 d8(k)=0
enddo enddo
endif endif
nblock0=nblock nblock0=nblock
tdiff=mod(0.001d0*msec,60.d0)-mod(Tsec,60.d0) tdiff=mod(0.001d0*msec,60.d0)-mod(Tsec,60.d0)
if(tdiff.lt.-30.) tdiff=tdiff+60. if(tdiff.lt.-30.) tdiff=tdiff+60.
if(tdiff.gt.30.) tdiff=tdiff-60. if(tdiff.gt.30.) tdiff=tdiff-60.
! Move data into Rx buffer and compute average signal level. ! Move data into Rx buffer and compute average signal level.
sq=0. sq=0.
do i=1,174 do i=1,174
k=k+1 k=k+1
d8(k)=buf8(i) d8(k)=buf8(i)
k2=k k2=k
n=1 n=1
if(k.gt.NSMAX) then if(k.gt.NSMAX) then
k2=k2-NSMAX k2=k2-NSMAX
n=2 n=2
endif endif
x1=id(1,k2,n) x1=id(1,k2,n)
x2=id(2,k2,n) x2=id(2,k2,n)
x3=id(3,k2,n) x3=id(3,k2,n)
x4=id(4,k2,n) x4=id(4,k2,n)
sq=sq + x1*x1 + x2*x2 + x3*x3 + x4*x4 sq=sq + x1*x1 + x2*x2 + x3*x3 + x4*x4
enddo enddo
sqave=sqave + u*(sq-sqave) sqave=sqave + u*(sq-sqave)
rxnoise=10.0*log10(sqave) - 48.0 rxnoise=10.0*log10(sqave) - 48.0
kxp=k kxp=k
20 if(nsec.ne.nsec0) then 20 if(nsec.ne.nsec0) then
nsec0=nsec nsec0=nsec
mutch=nseclr/3600 mutch=nseclr/3600
mutcm=mod(nseclr/60,60) mutcm=mod(nseclr/60,60)
mutc=100*mutch + mutcm mutc=100*mutch + mutcm
! If we have not transmitted in this minute, see if it's time to start FFTs ! If we have not transmitted in this minute, see if it's time to start FFTs
if(ntx.eq.0 .and. lauto+monitoring.ne.0) then if(ntx.eq.0 .and. lauto+monitoring.ne.0) then
if(ns.ge.nt1 .and. ndone1.eq.0 .and. synced) then if(ns.ge.nt1 .and. ndone1.eq.0 .and. synced) then
nutc=mutc nutc=mutc
fcenter=center_freq fcenter=center_freq
kbuf=kb kbuf=kb
kk=k kk=k
ndiskdat=0 ndiskdat=0
ndone1=1 ndone1=1
endif endif
! See if it's time to start the full decoding procedure. ! See if it's time to start the full decoding procedure.
nhsym=(k-(kbuf-1)*60*96000)/17832.9252 nhsym=(k-(kbuf-1)*60*96000)/17832.9252
if(ndone1.eq.1 .and. nhsym.ge.279 .and.ndone2.eq.0) then if(ndone1.eq.1 .and. nhsym.ge.279 .and.ndone2.eq.0) then
kk=k kk=k
nlost=lost_tot ! Save stats for printout nlost=lost_tot ! Save stats for printout
ndone2=1 ndone2=1
! print*,'recvpkt 2:',ns,kb,k ! print*,'recvpkt 2:',ns,kb,k
endif endif
endif endif
! if(ns.le.5 .or. ns.ge.46) write(*,3001) ns,ndone1,kb, & ! if(ns.le.5 .or. ns.ge.46) write(*,3001) ns,ndone1,kb, &
! kbuf,ntx,kk,tdiff ! kbuf,ntx,kk,tdiff
!3001 format(5i4,i11,f8.2) !3001 format(5i4,i11,f8.2)
endif endif
go to 10 go to 10
end subroutine recvpkt end subroutine recvpkt

24
rfile.f90
View File

@ -1,12 +1,12 @@
!----------------------------------------------------- rfile !----------------------------------------------------- rfile
subroutine rfile(lu,ibuf,n,ierr) subroutine rfile(lu,ibuf,n,ierr)
integer*1 ibuf(n) integer*1 ibuf(n)
read(lu,end=998) ibuf read(lu,end=998) ibuf
ierr=0 ierr=0
go to 999 go to 999
998 ierr=1002 998 ierr=1002
999 return 999 return
end subroutine rfile end subroutine rfile

44
rfile3.c
View File

@ -1,22 +1,22 @@
#include <stdio.h> #include <stdio.h>
void rfile3_(char *infile, char buf[], int *nbytes0) void rfile3_(char *infile, char buf[], int *nbytes0)
{ {
int n,nbytes; int n,nbytes;
static int first=1; static int first=1;
static FILE *fd=NULL; static FILE *fd=NULL;
nbytes=*nbytes0; nbytes=*nbytes0;
if(first) { if(first) {
fd = fopen(infile,"rb"); fd = fopen(infile,"rb");
if(fd == NULL) { if(fd == NULL) {
printf("Cannot open %s\n",infile); printf("Cannot open %s\n",infile);
exit(0); exit(0);
} }
first=0; first=0;
} }
n=fread(buf,1,nbytes,fd); n=fread(buf,1,nbytes,fd);
printf("b: %d %d\n",nbytes,n); printf("b: %d %d\n",nbytes,n);
return(n); return(n);
} }

36
rfile3a.f90 → rfile3a.F90
View File

@ -1,18 +1,18 @@
!----------------------------------------------------- rfile3a !----------------------------------------------------- rfile3a
subroutine rfile3a(infile,ibuf,n,ierr) subroutine rfile3a(infile,ibuf,n,ierr)
character*(*) infile character*(*) infile
integer*1 ibuf(n) integer*1 ibuf(n)
#ifdef CVF #ifdef CVF
open(10,file=infile,form='binary',status='old',err=998) open(10,file=infile,form='binary',status='old',err=998)
#else #else
open(10,file=infile,access='stream',status='old',err=998) open(10,file=infile,access='stream',status='old',err=998)
#endif #endif
read(10,end=998) ibuf read(10,end=998) ibuf
ierr=0 ierr=0
go to 999 go to 999
998 ierr=1002 998 ierr=1002
999 close(10) 999 close(10)
return return
end subroutine rfile3a end subroutine rfile3a

110
savetf2.F90
View File

@ -1,55 +1,55 @@
subroutine savetf2(id,fnamedate,savedir) subroutine savetf2(id,fnamedate,savedir)
parameter (NZ=60*96000) parameter (NZ=60*96000)
parameter (NSPP=174) parameter (NSPP=174)
parameter (NPKTS=NZ/NSPP) parameter (NPKTS=NZ/NSPP)
integer*2 id(4,NZ) integer*2 id(4,NZ)
character*80 savedir,fname character*80 savedir,fname
character cdate*8,ctime2*10,czone*5,fnamedate*6 character cdate*8,ctime2*10,czone*5,fnamedate*6
integer itt(8) integer itt(8)
data nloc/-1/ data nloc/-1/
save nloc save nloc
call date_and_time(cdate,ctime2,czone,itt) call date_and_time(cdate,ctime2,czone,itt)
nh=itt(5)-itt(4)/60 nh=itt(5)-itt(4)/60
nm=itt(6) nm=itt(6)
ns=itt(7) ns=itt(7)
if(ns.lt.50) nm=nm-1 if(ns.lt.50) nm=nm-1
if(nm.lt.0) then if(nm.lt.0) then
nm=nm+60 nm=nm+60
nh=nh-1 nh=nh-1
endif endif
if(nh.lt.0) nh=nh+24 if(nh.lt.0) nh=nh+24
if(nh.ge.24) nh=nh-24 if(nh.ge.24) nh=nh-24
write(fname,1001) fnamedate,nh,nm write(fname,1001) fnamedate,nh,nm
1001 format('/',a6,'_',2i2.2,'.tf2') 1001 format('/',a6,'_',2i2.2,'.tf2')
do i=80,1,-1 do i=80,1,-1
if(savedir(i:i).ne.' ') go to 1 if(savedir(i:i).ne.' ') go to 1
enddo enddo
1 iz=i 1 iz=i
fname=savedir(1:iz)//fname fname=savedir(1:iz)//fname
#ifdef CVF #ifdef CVF
open(17,file=fname,status='unknown',form='binary',err=998) open(17,file=fname,status='unknown',form='binary',err=998)
#else #else
open(17,file=fname,status='unknown',access='stream',err=998) open(17,file=fname,status='unknown',access='stream',err=998)
#endif #endif
if(nloc.eq.-1) nloc=loc(id) if(nloc.eq.-1) nloc=loc(id)
n=abs(loc(id)-nloc) n=abs(loc(id)-nloc)
if(n.eq.0 .or. n.eq.46080000) then if(n.eq.0 .or. n.eq.46080000) then
write(17,err=997) id write(17,err=997) id
else else
print*,'Address of id() clobbered???',nloc,loc(id) print*,'Address of id() clobbered???',nloc,loc(id)
endif endif
close(17) close(17)
go to 999 go to 999
997 print*,'Error writing tf2 file' 997 print*,'Error writing tf2 file'
print*,fname print*,fname
go to 999 go to 999
998 print*,'Cannot open file:' 998 print*,'Cannot open file:'
print*,fname print*,fname
999 return 999 return
end subroutine savetf2 end subroutine savetf2

38
sec_midn.F90
View File

@ -1,19 +1,19 @@
real function sec_midn() real function sec_midn()
sec_midn=secnds(0.0) sec_midn=secnds(0.0)
return return
end function sec_midn end function sec_midn
subroutine sleep_msec(n) subroutine sleep_msec(n)
#ifdef CVF #ifdef CVF
use dflib use dflib
#endif #endif
#ifdef CVF #ifdef CVF
call sleepqq(n) call sleepqq(n)
#else #else
call usleep(1000*n) call usleep(1000*n)
#endif #endif
return return
end subroutine sleep_msec end subroutine sleep_msec

6
spcom.f90
View File

@ -1,3 +1,3 @@
parameter (NFFT=32768) parameter (NFFT=32768)
common/spcom/ss(4,322,NFFT),ss5(322,NFFT),savg(4,NFFT),nhsym, & common/spcom/ss(4,322,NFFT),ss5(322,NFFT),savg(4,NFFT),nhsym, &
ssz(4,322,NFFT),ssz5(322,NFFT),szavg(4,NFFT) ssz(4,322,NFFT),ssz5(322,NFFT),szavg(4,NFFT)

284
spec.f90
View File

@ -1,142 +1,142 @@
subroutine spec(brightness,contrast,ngain,nspeed,a,a2) subroutine spec(brightness,contrast,ngain,nspeed,a,a2)
parameter (NX=750,NY=130,NTOT=NX*NY) parameter (NX=750,NY=130,NTOT=NX*NY)
! Input: ! Input:
integer brightness,contrast !Display parameters integer brightness,contrast !Display parameters
integer ngain !Digital gain for input audio integer ngain !Digital gain for input audio
integer nspeed !Scrolling speed index integer nspeed !Scrolling speed index
! Output: ! Output:
integer*2 a(NTOT) !Pixel values for NX x NY array integer*2 a(NTOT) !Pixel values for NX x NY array
integer*2 a2(NTOT) !Pixel values for NX x NY array integer*2 a2(NTOT) !Pixel values for NX x NY array
logical first logical first
integer nstep(5) integer nstep(5)
integer hist(0:1000) integer hist(0:1000)
! Could save memory by doing the averaging-by-7 (or 10?) of ss5 in symspec. ! Could save memory by doing the averaging-by-7 (or 10?) of ss5 in symspec.
include 'spcom.f90' include 'spcom.f90'
real s(NFFT,NY),savg2(NFFT) real s(NFFT,NY),savg2(NFFT)
include 'gcom1.f90' include 'gcom1.f90'
include 'gcom2.f90' include 'gcom2.f90'
include 'gcom3.f90' include 'gcom3.f90'
include 'gcom4.f90' include 'gcom4.f90'
data first/.true./ data first/.true./
data nstep/28,20,14,10,7/ !Integration limits data nstep/28,20,14,10,7/ !Integration limits
save save
if(first) then if(first) then
df=96000.0/nfft df=96000.0/nfft
call zero(a,NX*NY/2) call zero(a,NX*NY/2)
call zero(a2,NX*NY/2) call zero(a2,NX*NY/2)
first=.false. first=.false.
endif endif
nadd=nstep(nspeed) nadd=nstep(nspeed)
nlines=322/nadd nlines=322/nadd
call zero(s,NFFT*NY) call zero(s,NFFT*NY)
k=0 k=0
do j=1,nlines do j=1,nlines
do n=1,nadd do n=1,nadd
k=k+1 k=k+1
do i=1,NFFT do i=1,NFFT
s(i,j)=s(i,j) + ss5(k,i) s(i,j)=s(i,j) + ss5(k,i)
enddo enddo
enddo enddo
enddo enddo
call zero(savg2,NFFT) call zero(savg2,NFFT)
do j=1,nlines do j=1,nlines
do i=1,NFFT do i=1,NFFT
savg2(i)=savg2(i) + s(i,j) savg2(i)=savg2(i) + s(i,j)
enddo enddo
enddo enddo
ia=0.08*NFFT ia=0.08*NFFT
ib=0.92*NFFT ib=0.92*NFFT
smin=1.e30 smin=1.e30
smax=-smin smax=-smin
sum=0. sum=0.
nsum=0 nsum=0
do i=ia,ib do i=ia,ib
smin=min(savg2(i),smin) smin=min(savg2(i),smin)
smax=max(savg2(i),smax) smax=max(savg2(i),smax)
if(savg2(i).lt.10000.0) then if(savg2(i).lt.10000.0) then
sum=sum + savg2(i) sum=sum + savg2(i)
nsum=nsum+1 nsum=nsum+1
endif endif
enddo enddo
ave=sum/nsum ave=sum/nsum
call zero(hist,1001) call zero(hist,1001)
do i=ia,ib do i=ia,ib
n=savg2(i) * (300.0/ave) n=savg2(i) * (300.0/ave)
if(n.gt.1000) n=1000 if(n.gt.1000) n=1000
if(n.ge.0 .and. n.le.1000) hist(n)=hist(n)+1 if(n.ge.0 .and. n.le.1000) hist(n)=hist(n)+1
enddo enddo
sum=0. sum=0.
do i=0,1000 do i=0,1000
sum=sum + float(hist(i))/(ib-ia+1) sum=sum + float(hist(i))/(ib-ia+1)
if(sum.gt.0.4) go to 10 if(sum.gt.0.4) go to 10
enddo enddo
10 base=i*ave/300.0 10 base=i*ave/300.0
base=base/(nadd*nlines) base=base/(nadd*nlines)
newpts=NX*nlines newpts=NX*nlines
do i=newpts+1,NX*NY do i=newpts+1,NX*NY
a(i)=a(i-newpts) a(i)=a(i-newpts)
a2(i)=a2(i-newpts) a2(i)=a2(i-newpts)
enddo enddo
logmap=1 logmap=1
gamma=1.3 + 0.01*contrast gamma=1.3 + 0.01*contrast
offset=(brightness+64.0)/2 offset=(brightness+64.0)/2
if(logmap.eq.1) then if(logmap.eq.1) then
gain=40*sqrt(nstep(nspeed)/5.0) * 5.0**(0.01*contrast) gain=40*sqrt(nstep(nspeed)/5.0) * 5.0**(0.01*contrast)
offset=brightness/2 + 10 offset=brightness/2 + 10
endif endif
fac=20.0/nadd fac=20.0/nadd
fac=fac*0.065/base fac=fac*0.065/base
! fac=fac*(0.1537/base) ! fac=fac*(0.1537/base)
foffset=0.001*(1270+nfcal) foffset=0.001*(1270+nfcal)
nbpp=(nfb-nfa)*NFFT/(96.0*NX) !Bins per pixel in wideband (upper) waterfall nbpp=(nfb-nfa)*NFFT/(96.0*NX) !Bins per pixel in wideband (upper) waterfall
fselect=mousefqso + foffset - 1000.d0*(fcenter-144.125d0) fselect=mousefqso + foffset - 1000.d0*(fcenter-144.125d0)
imid=nint(1000.0*(fselect-125.0+48.0)/df) imid=nint(1000.0*(fselect-125.0+48.0)/df)
fmid=0.5*(nfa+nfb) + foffset fmid=0.5*(nfa+nfb) + foffset
imid0=nint(1000.0*(fmid-125.0+48.0)/df) - nbpp/2 !Last term is empirical imid0=nint(1000.0*(fmid-125.0+48.0)/df) - nbpp/2 !Last term is empirical
i0=imid-375 i0=imid-375
ii0=imid0-375*nbpp ii0=imid0-375*nbpp
! if(nfullspec.eq.1) then ! if(nfullspec.eq.1) then
! nbpp=NFFT/NX ! nbpp=NFFT/NX
! ii0=0 ! ii0=0
! endif ! endif
k=0 k=0
do j=nlines,1,-1 !Reverse order so last will be on top do j=nlines,1,-1 !Reverse order so last will be on top
do i=1,NX do i=1,NX
k=k+1 k=k+1
n=0 n=0
x=0. x=0.
iia=(i-1)*nbpp + ii0 + 1 iia=(i-1)*nbpp + ii0 + 1
iib=i*nbpp + ii0 iib=i*nbpp + ii0
do ii=iia,iib do ii=iia,iib
x=max(x,s(ii,j)) x=max(x,s(ii,j))
enddo enddo
x=fac*x x=fac*x
if(x.gt.0.0 .and. logmap.eq.0) n=(2.0*x)**gamma + offset if(x.gt.0.0 .and. logmap.eq.0) n=(2.0*x)**gamma + offset
if(x.gt.0.0 .and. logmap.eq.1) n=gain*log10(1.0*x) + offset if(x.gt.0.0 .and. logmap.eq.1) n=gain*log10(1.0*x) + offset
n=min(252,max(0,n)) n=min(252,max(0,n))
a(k)=n a(k)=n
! Now do the lower (zoomed) waterfall with one FFT bin per pixel. ! Now do the lower (zoomed) waterfall with one FFT bin per pixel.
n=0 n=0
x=fac*s(i0+i-1,j) x=fac*s(i0+i-1,j)
if(x.gt.0.0 .and. logmap.eq.0) n=(3.0*x)**gamma + offset if(x.gt.0.0 .and. logmap.eq.0) n=(3.0*x)**gamma + offset
if(x.gt.0.0 .and. logmap.eq.1) n=1.2*gain*log10(1.0*x) + offset if(x.gt.0.0 .and. logmap.eq.1) n=1.2*gain*log10(1.0*x) + offset
n=min(252,max(0,n)) n=min(252,max(0,n))
a2(k)=n a2(k)=n
enddo enddo
enddo enddo
return return
end subroutine spec end subroutine spec

344
symspec.f90
View File

@ -1,172 +1,172 @@
subroutine symspec(id,kbuf,kk,kkdone,nutc,newdat) subroutine symspec(id,kbuf,kk,kkdone,nutc,newdat)
! Compute spectra at four polarizations, using half-symbol steps. ! Compute spectra at four polarizations, using half-symbol steps.
parameter (NSMAX=60*96000) parameter (NSMAX=60*96000)
integer*2 id(4,NSMAX,2) integer*2 id(4,NSMAX,2)
complex z complex z
real*8 ts,hsym real*8 ts,hsym
include 'spcom.f90' include 'spcom.f90'
include 'gcom2.f90' include 'gcom2.f90'
complex cx(NFFT),cy(NFFT) ! pad to 32k with zeros complex cx(NFFT),cy(NFFT) ! pad to 32k with zeros
data kbuf0/-999/,n/0/ data kbuf0/-999/,n/0/
save save
kkk=kk kkk=kk
if(kbuf.eq.2) kkk=kk-5760000 if(kbuf.eq.2) kkk=kk-5760000
fac=0.0002 fac=0.0002
hsym=2048.d0*96000.d0/11025.d0 !Samples per half symbol hsym=2048.d0*96000.d0/11025.d0 !Samples per half symbol
npts=hsym !Integral samples per half symbol npts=hsym !Integral samples per half symbol
ntot=322 !Half symbols per transmission ntot=322 !Half symbols per transmission
! ntot=279 !Half symbols in 51.8 sec ! ntot=279 !Half symbols in 51.8 sec
if(kbuf.ne.kbuf0 .or. ndiskdat.eq.1) then if(kbuf.ne.kbuf0 .or. ndiskdat.eq.1) then
kkdone=0 kkdone=0
kbuf0=kbuf kbuf0=kbuf
ts=1.d0 - hsym ts=1.d0 - hsym
n=0 n=0
do ip=1,4 do ip=1,4
do i=1,NFFT do i=1,NFFT
szavg(ip,i)=0. szavg(ip,i)=0.
enddo enddo
enddo enddo
! Get baseline power level for this minute ! Get baseline power level for this minute
n1=200 !Block size (somewhat arbitrary) n1=200 !Block size (somewhat arbitrary)
n2=(kkk-kkdone)/n1 !Number of blocks n2=(kkk-kkdone)/n1 !Number of blocks
k=0 !Starting place k=0 !Starting place
sqq=0. sqq=0.
nsqq=0 nsqq=0
do j=1,n2 do j=1,n2
sq=0. sq=0.
do i=1,n1 !Find power in each block do i=1,n1 !Find power in each block
k=k+1 k=k+1
x1=id(1,k,kbuf) x1=id(1,k,kbuf)
x2=id(2,k,kbuf) x2=id(2,k,kbuf)
x3=id(3,k,kbuf) x3=id(3,k,kbuf)
x4=id(4,k,kbuf) x4=id(4,k,kbuf)
sq=sq + x1*x1 + x2*x2 + x3*x3 + x4*x4 sq=sq + x1*x1 + x2*x2 + x3*x3 + x4*x4
enddo enddo
if(sq.lt.n1*10000.) then !Find power in good blocks if(sq.lt.n1*10000.) then !Find power in good blocks
sqq=sqq+sq sqq=sqq+sq
nsqq=nsqq+1 nsqq=nsqq+1
endif endif
enddo enddo
sqave=sqq/nsqq !Average power in good blocks sqave=sqq/nsqq !Average power in good blocks
nclip=0 nclip=0
nz2=0 nz2=0
endif endif
if(nblank.ne.0) then if(nblank.ne.0) then
! Apply final noise blanking ! Apply final noise blanking
n2=(kkk-kkdone)/n1 n2=(kkk-kkdone)/n1
k=kkdone k=kkdone
do j=1,n2 do j=1,n2
sq=0. sq=0.
do i=1,n1 do i=1,n1
k=k+1 k=k+1
x1=id(1,k,kbuf) x1=id(1,k,kbuf)
x2=id(2,k,kbuf) x2=id(2,k,kbuf)
x3=id(3,k,kbuf) x3=id(3,k,kbuf)
x4=id(4,k,kbuf) x4=id(4,k,kbuf)
sq=sq + x1*x1 + x2*x2 + x3*x3 + x4*x4 sq=sq + x1*x1 + x2*x2 + x3*x3 + x4*x4
enddo enddo
! If power in this block is excessive, blank it. ! If power in this block is excessive, blank it.
if(sq.gt.1.5*sqave) then if(sq.gt.1.5*sqave) then
do i=k-n1+1,k do i=k-n1+1,k
id(1,i,kbuf)=0 id(1,i,kbuf)=0
id(2,i,kbuf)=0 id(2,i,kbuf)=0
id(3,i,kbuf)=0 id(3,i,kbuf)=0
id(4,i,kbuf)=0 id(4,i,kbuf)=0
enddo enddo
nclip=nclip+1 nclip=nclip+1
endif endif
enddo enddo
nz2=nz2+n2 nz2=nz2+n2
pctblank=nclip*100.0/nz2 pctblank=nclip*100.0/nz2
! write(*,3002) nblank,n2,nz2,nclip,kkk,kkdone,pctblank,sqave ! write(*,3002) nblank,n2,nz2,nclip,kkk,kkdone,pctblank,sqave
!3002 format(4i6,2i9,f8.1,f10.0) !3002 format(4i6,2i9,f8.1,f10.0)
endif endif
!### !###
do nn=1,ntot do nn=1,ntot
i0=ts+hsym !Starting sample pointer i0=ts+hsym !Starting sample pointer
if((i0+npts-1).gt.kkk) go to 998 !See if we have enough points if((i0+npts-1).gt.kkk) go to 998 !See if we have enough points
i1=ts+2*hsym !Next starting sample pointer i1=ts+2*hsym !Next starting sample pointer
ts=ts+hsym !OK, update the exact sample pointer ts=ts+hsym !OK, update the exact sample pointer
do i=1,npts !Copy data to FFT arrays do i=1,npts !Copy data to FFT arrays
xr=fac*id(1,i0+i,kbuf) xr=fac*id(1,i0+i,kbuf)
xi=fac*id(2,i0+i,kbuf) xi=fac*id(2,i0+i,kbuf)
cx(i)=cmplx(xr,xi) cx(i)=cmplx(xr,xi)
yr=fac*id(3,i0+i,kbuf) yr=fac*id(3,i0+i,kbuf)
yi=fac*id(4,i0+i,kbuf) yi=fac*id(4,i0+i,kbuf)
cy(i)=cmplx(yr,yi) cy(i)=cmplx(yr,yi)
enddo enddo
do i=npts+1,NFFT !Pad to 32k with zeros do i=npts+1,NFFT !Pad to 32k with zeros
cx(i)=0. cx(i)=0.
cy(i)=0. cy(i)=0.
enddo enddo
call four2a(cx,NFFT,1,1,1) !Do the FFTs call four2a(cx,NFFT,1,1,1) !Do the FFTs
call four2a(cy,NFFT,1,1,1) call four2a(cy,NFFT,1,1,1)
n=n+1 n=n+1
do i=1,NFFT !Save and accumulate power spectra do i=1,NFFT !Save and accumulate power spectra
sx=real(cx(i))**2 + aimag(cx(i))**2 sx=real(cx(i))**2 + aimag(cx(i))**2
ssz(1,n,i)=sx ! Pol = 0 ssz(1,n,i)=sx ! Pol = 0
szavg(1,i)=szavg(1,i) + sx szavg(1,i)=szavg(1,i) + sx
z=cx(i) + cy(i) z=cx(i) + cy(i)
s45=0.5*(real(z)**2 + aimag(z)**2) s45=0.5*(real(z)**2 + aimag(z)**2)
ssz(2,n,i)=s45 ! Pol = 45 ssz(2,n,i)=s45 ! Pol = 45
szavg(2,i)=szavg(2,i) + s45 szavg(2,i)=szavg(2,i) + s45
sy=real(cy(i))**2 + aimag(cy(i))**2 sy=real(cy(i))**2 + aimag(cy(i))**2
ssz(3,n,i)=sy ! Pol = 90 ssz(3,n,i)=sy ! Pol = 90
szavg(3,i)=szavg(3,i) + sy szavg(3,i)=szavg(3,i) + sy
z=cx(i) - cy(i) z=cx(i) - cy(i)
s135=0.5*(real(z)**2 + aimag(z)**2) s135=0.5*(real(z)**2 + aimag(z)**2)
ssz(4,n,i)=s135 ! Pol = 135 ssz(4,n,i)=s135 ! Pol = 135
szavg(4,i)=szavg(4,i) + s135 szavg(4,i)=szavg(4,i) + s135
z=cx(i)*conjg(cy(i)) z=cx(i)*conjg(cy(i))
! Leif's formula: ! Leif's formula:
! ss5(n,i)=0.5*(sx+sy) + (real(z)**2 + aimag(z)**2 - ! ss5(n,i)=0.5*(sx+sy) + (real(z)**2 + aimag(z)**2 -
! + sx*sy)/(sx+sy) ! + sx*sy)/(sx+sy)
! Leif's suggestion: ! Leif's suggestion:
! ss5(n,i)=max(sx,s45,sy,s135) ! ss5(n,i)=max(sx,s45,sy,s135)
! Linearly polarized component, from the Stokes parameters: ! Linearly polarized component, from the Stokes parameters:
q=sx - sy q=sx - sy
u=2.0*real(z) u=2.0*real(z)
! v=2.0*aimag(z) ! v=2.0*aimag(z)
ssz5(n,i)=0.707*sqrt(q*q + u*u) ssz5(n,i)=0.707*sqrt(q*q + u*u)
enddo enddo
! if(n.eq.ntot) then ! if(n.eq.ntot) then
if(n.ge.279) then if(n.ge.279) then
call move(ssz5,ss5,322*NFFT) call move(ssz5,ss5,322*NFFT)
write(utcdata,1002) nutc write(utcdata,1002) nutc
1002 format(i4.4) 1002 format(i4.4)
utcdata=utcdata(1:2)//':'//utcdata(3:4) utcdata=utcdata(1:2)//':'//utcdata(3:4)
newspec=1 newspec=1
call move(ssz,ss,4*322*NFFT) call move(ssz,ss,4*322*NFFT)
call move(szavg,savg,4*NFFT) call move(szavg,savg,4*NFFT)
newdat=1 newdat=1
ndecoding=1 ndecoding=1
go to 999 go to 999
endif endif
kkdone=i1-1 kkdone=i1-1
nhsym=n nhsym=n
call sleep_msec(0) call sleep_msec(0)
enddo enddo
998 kkdone=i1-1 998 kkdone=i1-1
999 continue 999 continue
return return
end subroutine symspec end subroutine symspec

26
sysqqq.f90
View File

@ -1,13 +1,13 @@
subroutine sysqqq(cmnd,iret) subroutine sysqqq(cmnd,iret)
#ifdef CVF #ifdef CVF
use dfport use dfport
#else #else
integer system integer system
#endif #endif
character*(*) cmnd character*(*) cmnd
iret=system(cmnd) iret=system(cmnd)
return return
end subroutine sysqqq end subroutine sysqqq

274
wsjtgen.F90
View File

@ -1,137 +1,137 @@
subroutine wsjtgen subroutine wsjtgen
! Compute the waveform to be transmitted. ! Compute the waveform to be transmitted.
! Input: txmsg message to be transmitted, up to 28 characters ! Input: txmsg message to be transmitted, up to 28 characters
! samfacout fsample_out/11025.d0 ! samfacout fsample_out/11025.d0
! Output: iwave waveform data, i*2 format ! Output: iwave waveform data, i*2 format
! nwave number of samples ! nwave number of samples
! sendingsh 0=normal; 1=shorthand (FSK441) or plain text (JT65) ! sendingsh 0=normal; 1=shorthand (FSK441) or plain text (JT65)
parameter (NMSGMAX=28) !Max characters per message parameter (NMSGMAX=28) !Max characters per message
parameter (NSPD=25) !Samples per dit parameter (NSPD=25) !Samples per dit
parameter (NDPC=3) !Dits per character parameter (NDPC=3) !Dits per character
parameter (NWMAX=661500) !Max length of waveform = 60*11025 parameter (NWMAX=661500) !Max length of waveform = 60*11025
parameter (NTONES=4) !Number of FSK tones parameter (NTONES=4) !Number of FSK tones
character msg*28,msgsent*22,idmsg*22 character msg*28,msgsent*22,idmsg*22
real*8 freq,dpha,twopi real*8 freq,dpha,twopi
character testfile*27 character testfile*27
logical lcwid logical lcwid
integer*2 icwid(110250),jwave(NWMAX) integer*2 icwid(110250),jwave(NWMAX)
integer*1 hdr(44) integer*1 hdr(44)
integer*2 nfmt2,nchan2,nbitsam2,nbytesam2 integer*2 nfmt2,nchan2,nbitsam2,nbytesam2
character*4 ariff,awave,afmt,adata character*4 ariff,awave,afmt,adata
common/hdr/ariff,lenfile,awave,afmt,lenfmt,nfmt2,nchan2, & common/hdr/ariff,lenfile,awave,afmt,lenfmt,nfmt2,nchan2, &
nsamrate,nbytesec,nbytesam2,nbitsam2,adata,ndata,jwave nsamrate,nbytesec,nbytesam2,nbitsam2,adata,ndata,jwave
equivalence (ariff,hdr) equivalence (ariff,hdr)
data twopi/6.28318530718d0/ data twopi/6.28318530718d0/
include 'gcom1.f90' include 'gcom1.f90'
include 'gcom2.f90' include 'gcom2.f90'
fsample_out=11025.d0*samfacout fsample_out=11025.d0*samfacout
lcwid=.false. lcwid=.false.
if(idinterval.gt.0) then if(idinterval.gt.0) then
n=(mod(int(tsec/60.d0),idinterval)) n=(mod(int(tsec/60.d0),idinterval))
if(n.eq.(1-txfirst)) lcwid=.true. if(n.eq.(1-txfirst)) lcwid=.true.
if(idinterval.eq.1) lcwid=.true. if(idinterval.eq.1) lcwid=.true.
endif endif
msg=txmsg msg=txmsg
ntxnow=ntxreq ntxnow=ntxreq
! Convert all letters to upper case ! Convert all letters to upper case
do i=1,28 do i=1,28
if(msg(i:i).ge.'a' .and. msg(i:i).le.'z') & if(msg(i:i).ge.'a' .and. msg(i:i).le.'z') &
msg(i:i)= char(ichar(msg(i:i))+ichar('A')-ichar('a')) msg(i:i)= char(ichar(msg(i:i))+ichar('A')-ichar('a'))
enddo enddo
txmsg=msg txmsg=msg
! Find message length ! Find message length
do i=NMSGMAX,1,-1 do i=NMSGMAX,1,-1
if(msg(i:i).ne.' ') go to 10 if(msg(i:i).ne.' ') go to 10
enddo enddo
i=1 i=1
10 nmsg=i 10 nmsg=i
nmsg0=nmsg nmsg0=nmsg
if(msg(1:1).eq.'@') then if(msg(1:1).eq.'@') then
if(msg(2:2).eq.'/' .or. ichar(msg(2:2)).eq.92) then if(msg(2:2).eq.'/' .or. ichar(msg(2:2)).eq.92) then
txmsg=msg txmsg=msg
testfile=msg(2:) testfile=msg(2:)
#ifdef CVF #ifdef CVF
open(18,file=testfile,form='binary',status='old',err=12) open(18,file=testfile,form='binary',status='old',err=12)
#else #else
open(18,file=testfile,access='stream',status='old',err=12) open(18,file=testfile,access='stream',status='old',err=12)
#endif #endif
go to 14 go to 14
12 print*,'Cannot open test file ',msg(2:) 12 print*,'Cannot open test file ',msg(2:)
go to 999 go to 999
14 read(18) hdr 14 read(18) hdr
if(ndata.gt.NTxMax) ndata=NTxMax if(ndata.gt.NTxMax) ndata=NTxMax
call rfile(18,iwave,ndata,ierr) call rfile(18,iwave,ndata,ierr)
close(18) close(18)
if(ierr.ne.0) print*,'Error reading test file ',msg(2:) if(ierr.ne.0) print*,'Error reading test file ',msg(2:)
nwave=ndata/2 nwave=ndata/2
do i=nwave,NTXMAX do i=nwave,NTXMAX
iwave(i)=0 iwave(i)=0
enddo enddo
sending=txmsg sending=txmsg
sendingsh=2 sendingsh=2
go to 999 go to 999
endif endif
! Transmit a fixed tone at specified frequency ! Transmit a fixed tone at specified frequency
freq=1000.0 freq=1000.0
if(msg(2:2).eq.'A' .or. msg(2:2).eq.'a') freq=882 if(msg(2:2).eq.'A' .or. msg(2:2).eq.'a') freq=882
if(msg(2:2).eq.'B' .or. msg(2:2).eq.'b') freq=1323 if(msg(2:2).eq.'B' .or. msg(2:2).eq.'b') freq=1323
if(msg(2:2).eq.'C' .or. msg(2:2).eq.'c') freq=1764 if(msg(2:2).eq.'C' .or. msg(2:2).eq.'c') freq=1764
if(msg(2:2).eq.'D' .or. msg(2:2).eq.'d') freq=2205 if(msg(2:2).eq.'D' .or. msg(2:2).eq.'d') freq=2205
if(freq.eq.1000.0) then if(freq.eq.1000.0) then
read(msg(2:),*,err=1) freq read(msg(2:),*,err=1) freq
goto 2 goto 2
1 txmsg='@1000' 1 txmsg='@1000'
nmsg=5 nmsg=5
nmsg0=5 nmsg0=5
endif endif
2 nwave=60*fsample_out 2 nwave=60*fsample_out
dpha=twopi*freq/fsample_out dpha=twopi*freq/fsample_out
do i=1,nwave do i=1,nwave
iwave(i)=32767.0*sin(i*dpha) iwave(i)=32767.0*sin(i*dpha)
enddo enddo
goto 900 goto 900
endif endif
! We're in JT65 mode. ! We're in JT65 mode.
if(mode(5:5).eq.'A') mode65=1 if(mode(5:5).eq.'A') mode65=1
if(mode(5:5).eq.'B') mode65=2 if(mode(5:5).eq.'B') mode65=2
if(mode(5:5).eq.'C') mode65=4 if(mode(5:5).eq.'C') mode65=4
call gen65(msg,mode65,samfacout,iwave,nwave,sendingsh,msgsent) call gen65(msg,mode65,samfacout,iwave,nwave,sendingsh,msgsent)
if(lcwid) then if(lcwid) then
! Generate and insert the CW ID. ! Generate and insert the CW ID.
wpm=25. wpm=25.
freqcw=800. freqcw=800.
idmsg=MyCall//' ' idmsg=MyCall//' '
call gencwid(idmsg,wpm,freqcw,samfacout,icwid,ncwid) call gencwid(idmsg,wpm,freqcw,samfacout,icwid,ncwid)
k=nwave k=nwave
do i=1,ncwid do i=1,ncwid
k=k+1 k=k+1
iwave(k)=icwid(i) iwave(k)=icwid(i)
enddo enddo
do i=1,2205 !Add 0.2 s of silence do i=1,2205 !Add 0.2 s of silence
k=k+1 k=k+1
iwave(k)=0 iwave(k)=0
enddo enddo
nwave=k nwave=k
endif endif
900 sending=txmsg 900 sending=txmsg
if(sendingsh.ne.1) sending=msgsent if(sendingsh.ne.1) sending=msgsent
nmsg=nmsg0 nmsg=nmsg0
999 return 999 return
end subroutine wsjtgen end subroutine wsjtgen