w4kek/WSJT-X
1
0
Fork 0
mirror of https://github.com/saitohirga/WSJT-X.git synced 2025-04-10 13:29:02 -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 302d035d79
commit cb34075ae0
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@
CPPFLAGS = @CPPFLAGS@
CFLAGS = @CFLAGS@
# WSJT specific C flags
# Map65 specific C flags
CFLAGS += -DBIGSYM=1 -fPIC
DEFS = @DEFS@
CFLAGS += ${DEFS}
CPPFLAGS += ${DEFS} -I.
# WSJT specific Fortran flags
FFLAGS += -Wall -Wno-precision-loss -fbounds-check -fno-second-underscore -fPIC
# MAP65 specific Fortran flags
# 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 -fPIC
#FFLAGS += -cpp -fno-second-underscore
all: Audio.so plrs plrr
# The default rules
.c.o:
${CC} ${CPPFLAGS} ${CFLAGS} -c -o ${<:.c=.o} $<
@ -30,14 +34,14 @@ FC=@FC@
COMPILER += @FC_LIB_PATH@
LDFLAGS += -L${COMPILER}
LIBS += /usr/lib/libfftw3f.a
PYTHON ?= @PYTHON@
RM ?= @RM@
F2PY = @F2PY@
###
all: Audio.so plrs plrr
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}
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
$(FC) -c -O0 -Wall -fPIC deep65.F

68
a2d.f90
View File

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

238
astro0.F90
View File

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

148
audio_init.F90
View File

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

28
azdist0.f90
View File

@ -1,14 +1,14 @@
!---------------------------------------------------- azdist0
subroutine azdist0(MyGrid,HisGrid,utch,nAz,nEl,nDmiles,nDkm,nHotAz,nHotABetter)
character*6 MyGrid,HisGrid
real*8 utch
!f2py intent(in) MyGrid,HisGrid,utch
!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(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)
return
end subroutine azdist0
!---------------------------------------------------- azdist0
subroutine azdist0(MyGrid,HisGrid,utch,nAz,nEl,nDmiles,nDkm,nHotAz,nHotABetter)
character*6 MyGrid,HisGrid
real*8 utch
!f2py intent(in) MyGrid,HisGrid,utch
!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(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)
return
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 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
AC_COPYRIGHT([$Id$])
AC_INIT([wsjt],[5.9.6])
AC_INIT([map65],[0.9])
AC_PREFIX_DEFAULT(/usr/local/)
@ -20,7 +20,7 @@ dnl Make sure autoconf doesn't interfere with cflags -jmallett
CFLAGS="$OLD_CFLAGS"
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}"
LIBS=" -lpthread ${LIBS}"
@ -86,11 +86,7 @@ AC_MSG_CHECKING([g95 lib path])
G95_LIB_PATH=`${G95} -print-file-name=`
AC_MSG_RESULT(${G95_LIB_PATH})
AC_PATH_PROG(GFORTRAN, gfortran)
dnl
dnl FreeBSD currently installs gfortran as gfortran41
dnl See http://gcc.gnu.org/fortran/
dnl
AC_PATH_PROG(GFORTRAN, gfortran41)
AC_PATH_PROG(GFORTRAN, gfortran43)
AC_MSG_CHECKING([gfortran lib path])
GFORTRAN_LIB_PATH=`${GFORTRAN} -print-file-name=`
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_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])
HAS_PORTAUDIO_H=0
HAS_PORTAUDIO_LIB=0
HAS_PORTAUDIO=0
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],
gcc_cv_header_string,
@ -215,27 +205,6 @@ AC_CONFIG_FILES( \
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 ====================
@ -286,86 +255,90 @@ dnl set defaults
dnl ============
if test "$alsa" != yes -a "$oss" != yes -a \
"$portaudio" != yes; then
if test $HAS_PORTAUDIO_H -eq 1; then
[portaudio=yes];
elif test $HAS_ASOUNDLIB_H -eq 1; then
[alsa=yes];
elif test $HAS_SOUNDCARD_H -eq 1; then
[oss=yes];
AC_MSG_CHECKING([for a v19 portaudio ])
portaudio_lib_dir="/usr/lib"
portaudio_include_dir="/usr/include"
AC_ARG_WITH([portaudio-include-dir],
AC_HELP_STRING([--with-portaudio-include-dir=<path>],
[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
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
AC_SUBST(NEEDPORTAUDIO, "")
fi
AC_MSG_RESULT([portaudio not found trying FreeBSD paths ])
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
dnl ==============
if test -e ${portaudio_include_dir}/portaudio.h; then
HAS_PORTAUDIO_H=1
fi
if test $HAS_ASOUNDLIB_H -eq 1; then
AC_DEFINE(HAS_ASOUNDLIB_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_SOUNDCARD_H -eq 1; then
AC_DEFINE(HAS_SOUNDCARD_H, 1, )
fi
if test $HAS_JACK_H -eq 1; then
AC_DEFINE(HAS_JACK_H, 1, )
fi
if test $HAS_PORTAUDIO_H -eq 1; then
AC_DEFINE(HAS_PORTAUDIO_H, 1, )
fi
if test $HAS_SAMPLERATE_H -eq 1; then
AC_DEFINE(HAS_SAMPLERATE_H, 1, )
if test $HAS_PORTAUDIO_H -eq 1 -a $HAS_PORTAUDIO_LIB -eq 1; then
AC_MSG_RESULT([found portaudio in FreeBSD paths, double checking it is v19 ])
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([How did you end up with a portaudio v18 here?])
else
AC_MSG_RESULT([found v19])
HAS_PORTAUDIO=1
HAS_PORTAUDIO_H=1
fi
fi
fi
dnl sanity tests.
dnl =============
if test "$alsa" = yes; then
if test $HAS_ASOUNDLIB_H -eq 0; then
AC_MSG_ERROR([You need asoundlib.h to use --enable-alsa])
fi
fi
if test "$oss" = yes; then
if test $HAS_SOUNDCARD_H -eq 0; then
AC_MSG_ERROR([You need soundcard.h to use --enable-oss])
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
if test $HAS_PORTAUDIO -eq 1; then
AC_DEFINE(HAS_PORTAUDIO, 1, )
AC_DEFINE(HAS_PORTAUDIO_H, 1, )
AC_DEFINE(HAS_PORTAUDIO_LIB, 1, )
else
fail=1
echo "This program needs portaudio v19 to compile."
echo "Please use --with-portaudio-include-dir= and"
echo " --with-portaudio-lib-dir= to set the paths."
fi
if test "$F2PY" = ""; then
@ -386,26 +359,14 @@ dnl do summary
echo
echo
if test $g95 == "yes"; then
if test $g95 = "yes"; then
echo "Using g95 as fortran compiler.";
fi
if test $gfortran == "yes"; then
if test $gfortran = "yes"; then
echo "Using gfortran as fortran compiler.";
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 "Compiling $PACKAGE_NAME $PACKAGE_VERSION"
echo

10
datcom.f90
View File

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

162
decode1.F90
View File

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

342
display.F90
View File

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

500
fivehz.F90
View File

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

330
ftn_init.F90
View File

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

18
ftn_quit.f90
View File

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

102
gcom1.f90
View File

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

242
gcom2.f90
View File

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

40
gcom3.f90
View File

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

20
gcom4.f90
View File

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

28
getfile.F90
View File

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

118
getfile2.F90
View File

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

38
i1tor4.f90
View File

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

778
map65a.F90
View File

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

56
pix2d65.f90
View File

@ -1,28 +1,28 @@
subroutine pix2d65(d2,jz)
! Compute data for green line in JT65 mode.
integer*2 d2(jz) !Raw input data
include 'gcom2.f90'
sum=0.
do i=1,jz
sum=sum+d2(i)
enddo
nave=nint(sum/jz)
nadd=nint(53.0*11025.0/500.0)
ngreen=min(jz/nadd,500)
k=0
do i=1,ngreen
sq=0.
do n=1,nadd
k=k+1
d2(k)=d2(k)-nave
x=d2(k)
sq=sq + x*x
enddo
green(i)=db(sq)-96.0
enddo
return
end subroutine pix2d65
subroutine pix2d65(d2,jz)
! Compute data for green line in JT65 mode.
integer*2 d2(jz) !Raw input data
include 'gcom2.f90'
sum=0.
do i=1,jz
sum=sum+d2(i)
enddo
nave=nint(sum/jz)
nadd=nint(53.0*11025.0/500.0)
ngreen=min(jz/nadd,500)
k=0
do i=1,ngreen
sq=0.
do n=1,nadd
k=k+1
d2(k)=d2(k)-nave
x=d2(k)
sq=sq + x*x
enddo
green(i)=db(sq)-96.0
enddo
return
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/socket.h>
#include <netinet/in.h>
#include <time.h>
#include <stdio.h>
*/
#include <arpa/inet.h>
#include <string.h>
#include <stdlib.h>
#define HELLO_PORT 50004
#define HELLO_GROUP "239.255.0.0"
#define MSGBUFSIZE 1416
struct sockaddr_in addr;
int fd;
void setup_rsocket_(void)
{
struct ip_mreq mreq;
u_int yes=1;
/* create what looks like an ordinary UDP socket */
if ((fd=socket(AF_INET,SOCK_DGRAM,0)) < 0) {
perror("socket");
exit(1);
}
/* allow multiple sockets to use the same PORT number */
if (setsockopt(fd,SOL_SOCKET,SO_REUSEADDR,&yes,sizeof(yes)) < 0) {
perror("Reusing ADDR failed");
exit(1);
}
/* set up destination address */
memset(&addr,0,sizeof(addr));
addr.sin_family=AF_INET;
addr.sin_addr.s_addr=htonl(INADDR_ANY); /* N.B.: differs from sender */
addr.sin_port=htons(HELLO_PORT);
/* bind to receive address */
if (bind(fd,(struct sockaddr *) &addr,sizeof(addr)) < 0) {
perror("bind");
exit(1);
}
/* use setsockopt() to request that the kernel join a multicast group */
mreq.imr_multiaddr.s_addr=inet_addr(HELLO_GROUP);
mreq.imr_interface.s_addr=htonl(INADDR_ANY);
if (setsockopt(fd,IPPROTO_IP,IP_ADD_MEMBERSHIP,&mreq,sizeof(mreq)) < 0) {
perror("setsockopt");
exit(1);
}
}
void recv_pkt_(char buf[])
{
int addrlen,nbytes;
addrlen=sizeof(addr);
if ((nbytes=recvfrom(fd,buf,1416,0,
(struct sockaddr *) &addr,&addrlen)) < 0) {
perror("recvfrom");
exit(1);
}
}
#include <sys/types.h>
#include <sys/socket.h>
#include <netinet/in.h>
/* The following don't seem to be needed?
#include <time.h>
#include <stdio.h>
*/
#include <arpa/inet.h>
#include <string.h>
#include <stdlib.h>
#define HELLO_PORT 50004
#define HELLO_GROUP "239.255.0.0"
#define MSGBUFSIZE 1416
struct sockaddr_in addr;
int fd;
void setup_rsocket_(void)
{
struct ip_mreq mreq;
u_int yes=1;
/* create what looks like an ordinary UDP socket */
if ((fd=socket(AF_INET,SOCK_DGRAM,0)) < 0) {
perror("socket");
exit(1);
}
/* allow multiple sockets to use the same PORT number */
if (setsockopt(fd,SOL_SOCKET,SO_REUSEADDR,&yes,sizeof(yes)) < 0) {
perror("Reusing ADDR failed");
exit(1);
}
/* set up destination address */
memset(&addr,0,sizeof(addr));
addr.sin_family=AF_INET;
addr.sin_addr.s_addr=htonl(INADDR_ANY); /* N.B.: differs from sender */
addr.sin_port=htons(HELLO_PORT);
/* bind to receive address */
if (bind(fd,(struct sockaddr *) &addr,sizeof(addr)) < 0) {
perror("bind");
exit(1);
}
/* use setsockopt() to request that the kernel join a multicast group */
mreq.imr_multiaddr.s_addr=inet_addr(HELLO_GROUP);
mreq.imr_interface.s_addr=htonl(INADDR_ANY);
if (setsockopt(fd,IPPROTO_IP,IP_ADD_MEMBERSHIP,&mreq,sizeof(mreq)) < 0) {
perror("setsockopt");
exit(1);
}
}
void recv_pkt_(char buf[])
{
int addrlen,nbytes;
addrlen=sizeof(addr);
if ((nbytes=recvfrom(fd,buf,1416,0,
(struct sockaddr *) &addr,&addrlen)) < 0) {
perror("recvfrom");
exit(1);
}
}

214
plrr_subs_win.c
View File

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

128
plrs_subs_win.c
View File

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

272
recvpkt.F90
View File

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

24
rfile.f90
View File

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

44
rfile3.c
View File

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

36
rfile3a.f90 → rfile3a.F90
View File

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

110
savetf2.F90
View File

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

38
sec_midn.F90
View File

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

6
spcom.f90
View File

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

344
symspec.f90
View File

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

26
sysqqq.f90
View File

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

274
wsjtgen.F90
View File

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