w4kek/WSJT-X
1
0
Fork 0
mirror of https://github.com/saitohirga/WSJT-X.git synced 2025-04-04 18:38:43 -04:00
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'map65' into develop

Browse Source
This commit is contained in:
Joe Taylor 2023-02-23 13:04:42 -05:00
commit df2728efb4
147 changed files with 17170 additions and 387 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
CMakeLists.txt
View File

@ -45,7 +45,7 @@ if (POLICY CMP0075)
endif ()
project (wsjtx
VERSION 2.6.1.0
VERSION 2.7.0.0
LANGUAGES C CXX Fortran
)
set (PROJECT_DESCRIPTION "WSJT-X: Digital Modes for Weak Signal Communications in Amateur Radio")
@ -71,7 +71,7 @@ message (STATUS "******************************************************")
include (set_build_type)
# RC 0 or omitted is a development build, GA is a General Availability release build
set_build_type (GA)
set_build_type (RC 1)
set (wsjtx_VERSION "${PROJECT_VERSION_MAJOR}.${PROJECT_VERSION_MINOR}.${PROJECT_VERSION_PATCH}${BUILD_TYPE_REVISION}")
#
@ -327,6 +327,7 @@ set (wsjt_FSRCS
lib/ft8_decode.f90
lib/ft4_decode.f90
lib/fst4_decode.f90
lib/get_q3list.f90
lib/jt9_decode.f90
lib/options.f90
lib/packjt.f90
@ -509,6 +510,7 @@ set (wsjt_FSRCS
lib/qra/q65/q65_ap.f90
lib/qra/q65/q65_loops.f90
lib/qra/q65/q65_set_list.f90
lib/qra/q65/q65_set_list2.f90
lib/refspectrum.f90
lib/savec2.f90
lib/save_dxbase.f90
@ -973,7 +975,10 @@ if (Fortran_COMPILER_NAME MATCHES "gfortran.*")
set (CMAKE_Fortran_FLAGS_RELEASE "${CMAKE_Fortran_FLAGS_RELEASE} -fbounds-check -funroll-all-loops -fno-f2c -ffpe-summary=invalid,zero,overflow,underflow ${General_FFLAGS}")
set (CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG} -g -fbacktrace -fbounds-check -fno-f2c -ffpe-summary=invalid,zero,overflow,underflow ${General_FFLAGS}")
### TEMPORARY: Let Fortran use RElEASE flags for DEBUG builds
#set (CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG} -g -fbacktrace -fbounds-check -fno-f2c -ffpe-summary=invalid,zero,overflow,underflow ${General_FFLAGS}")
set (CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_RELEASE} -fbounds-check -funroll-all-loops -fno-f2c -ffpe-summary=invalid,zero,overflow,underflow ${General_FFLAGS}")
# FPE traps currently disabled in Debug configuration builds until
# we decide if they are meaningful, without these FP instructions
@ -1424,9 +1429,10 @@ else (${OPENMP_FOUND} OR APPLE)
endif (${OPENMP_FOUND} OR APPLE)
if (WIN32)
# build map65
find_package (Portaudio REQUIRED)
add_subdirectory (map65)
# build map65 OR qmap
# add_subdirectory (map65)
add_subdirectory (qmap)
endif ()
# build the main application

10
Configuration.cpp
View File

@ -997,6 +997,15 @@ void Configuration::set_location (QString const& grid_descriptor)
m_->dynamic_grid_ = grid_descriptor.trimmed ();
}
void Configuration::setSpecial_Q65_Pileup()
{
m_->bSpecialOp_=true;
m_->ui_->gbSpecialOpActivity->setChecked(m_->bSpecialOp_);
m_->ui_->rbQ65pileup->setChecked(true);
m_->SelectedActivity_ = static_cast<int> (SpecialOperatingActivity::Q65_PILEUP);
m_->write_settings();
}
void Configuration::setSpecial_Hound()
{
m_->bSpecialOp_=true;
@ -1227,6 +1236,7 @@ Configuration::impl::impl (Configuration * self, QNetworkAccessManager * network
ui_->special_op_activity_button_group->setId (ui_->rbARRL_Digi, static_cast<int> (SpecialOperatingActivity::ARRL_DIGI));
ui_->special_op_activity_button_group->setId (ui_->rbFox, static_cast<int> (SpecialOperatingActivity::FOX));
ui_->special_op_activity_button_group->setId (ui_->rbHound, static_cast<int> (SpecialOperatingActivity::HOUND));
ui_->special_op_activity_button_group->setId (ui_->rbQ65pileup, static_cast<int> (SpecialOperatingActivity::Q65_PILEUP));
//
// setup PTT port combo box drop down content

5
Configuration.hpp
View File

@ -183,6 +183,7 @@ public:
bool highlight_only_fields () const;
bool include_WAE_entities () const;
bool highlight_73 () const;
void setSpecial_Q65_Pileup();
void setSpecial_Hound();
void setSpecial_Fox();
void setSpecial_None();
@ -190,8 +191,8 @@ public:
bool highlight_DXgrid () const;
bool Individual_Contest_Name() const;
// 0 1 2 3 4 5 6 7 8
enum class SpecialOperatingActivity {NONE, NA_VHF, EU_VHF, FIELD_DAY, RTTY, WW_DIGI, FOX, HOUND, ARRL_DIGI};
// 0 1 2 3 4 5 6 7 8 9
enum class SpecialOperatingActivity {NONE, NA_VHF, EU_VHF, FIELD_DAY, RTTY, WW_DIGI, FOX, HOUND, ARRL_DIGI, Q65_PILEUP};
SpecialOperatingActivity special_op_id () const;
struct CalibrationParams

25
Configuration.ui
View File

@ -2923,6 +2923,25 @@ Right click for insert and delete options.</string>
</attribute>
</widget>
</item>
<item row="4" column="0">
<widget class="QRadioButton" name="rbQ65pileup">
<property name="minimumSize">
<size>
<width>0</width>
<height>18</height>
</size>
</property>
<property name="toolTip">
<string>&lt;html&gt;&lt;head/&gt;&lt;body&gt;&lt;p&gt;Exchange 4-character locator instead of signal report. Provides q3-level sensitivities for the DX operator. Especially useful for 6m EME DXpeditions.&lt;/p&gt;&lt;/body&gt;&lt;/html&gt;</string>
</property>
<property name="text">
<string>Q65 Pileup</string>
</property>
<attribute name="buttonGroup">
<string notr="true">special_op_activity_button_group</string>
</attribute>
</widget>
</item>
<item row="2" column="3">
<layout class="QHBoxLayout" name="horizontalLayout_18" stretch="2,1,1">
<item>
@ -3337,12 +3356,12 @@ Right click for insert and delete options.</string>
</connections>
<buttongroups>
<buttongroup name="split_mode_button_group"/>
<buttongroup name="CAT_data_bits_button_group"/>
<buttongroup name="PTT_method_button_group"/>
<buttongroup name="CAT_handshake_button_group"/>
<buttongroup name="TX_audio_source_button_group"/>
<buttongroup name="special_op_activity_button_group"/>
<buttongroup name="TX_mode_button_group"/>
<buttongroup name="CAT_handshake_button_group"/>
<buttongroup name="CAT_data_bits_button_group"/>
<buttongroup name="PTT_method_button_group"/>
<buttongroup name="CAT_stop_bits_button_group"/>
</buttongroups>
</ui>

2
doc/common/links.adoc
View File

@ -80,7 +80,7 @@ d). Edit lines as needed. Keeping them in alphabetic order help see dupes.
:jtalert: https://hamapps.com/[JTAlert]
:launchpadki7mt: https://launchpad.net/~ki7mt[KI7MT PPA's]
:log4om: https://www.log4om.com[Log4OM]
:lunarEchoes: https://sourceforge.net/projects/wsjt/files/wsjtx-{VERSION}/LunarEchoes_QEX.pdf[QEX]
:lunarEchoes: https://wsjt.sourceforge.io/LunarEchoes_QEX.pdf[QEX]
:msk144: https://wsjt.sourceforge.io/MSK144_Protocol_QEX.pdf[QEX]
:msvcpp_redist: https://www.microsoft.com/en-ph/download/details.aspx?id=40784[Microsoft VC++ 2013 Redistributable]
:msys_url: https://sourceforge.net/projects/mingwbuilds/files/external-binary-packages/[MSYS Download]

24
lib/decoder.f90
View File

@ -46,6 +46,7 @@ subroutine multimode_decoder(ss,id2,params,nfsample)
logical baddata,newdat65,newdat9,single_decode,bVHF,bad0,newdat,ex
logical lprinthash22
integer*2 id2(NTMAX*12000)
integer nqf(20)
type(params_block) :: params
real*4 dd(NTMAX*12000)
character(len=20) :: datetime
@ -212,7 +213,28 @@ subroutine multimode_decoder(ss,id2,params,nfsample)
params%nfa,params%nfb,logical(params%nclearave), &
single_decode,logical(params%nagain),params%max_drift, &
logical(params%newdat),params%emedelay,mycall,hiscall,hisgrid, &
params%nQSOProgress,ncontest,logical(params%lapcqonly),navg0)
params%nQSOProgress,ncontest,logical(params%lapcqonly),navg0,nqf)
params%nclearave=.false.
if(.not.params%nagain) then
! Go through identified candidates again, treating each as if it had been
! double-clicked on the waterfall.
do k=1,20
if(nqf(k).eq.0) exit
if(params%nagain .and. abs(nqf(k)-params%nfqso).gt.params%ntol) cycle
nqd=1
navg0=0
ntol=5
call my_q65%decode(q65_decoded,id2,nqd,params%nutc,params%ntr, &
params%nsubmode,nqf(k),ntol,params%ndepth, &
params%nfa,params%nfb,logical(params%nclearave), &
.true.,.true.,params%max_drift, &
.false.,params%emedelay,mycall,hiscall,hisgrid, &
params%nQSOProgress,ncontest,logical(params%lapcqonly), &
navg0,nqf)
enddo
endif
call timer('dec_q65 ',1)
close(17)
go to 800

1
lib/fst4_decode.f90
View File

@ -610,6 +610,7 @@ contains
case(1800)
snr_calfac=320.0
case default
snr_calfac=430.0
end select
arg=snr_calfac*xsig/base - 1.0
if(arg.gt.0.0) then

3
lib/ft8/sync8.f90
View File

@ -1,5 +1,4 @@
subroutine sync8(dd,nfa,nfb,syncmin,nfqso,maxcand,nzhsym,candidate, &
ncand,sbase)
subroutine sync8(dd,nfa,nfb,syncmin,nfqso,maxcand,candidate,ncand,sbase)
include 'ft8_params.f90'
parameter (MAXPRECAND=1000)

6
lib/ft8_decode.f90
View File

@ -46,7 +46,6 @@ contains
procedure(ft8_decode_callback) :: callback
parameter (MAXCAND=600,MAX_EARLY=100)
real*8 tsec,tseq
real s(NH1,NHSYM)
real sbase(NH1)
real candidate(3,MAXCAND)
real dd(15*12000),dd1(15*12000)
@ -68,7 +67,7 @@ contains
real xdt_save(MAX_EARLY)
data nutc0/-1/
save s,dd,dd1,nutc0,ndec_early,itone_save,f1_save,xdt_save,lsubtracted,&
save dd,dd1,nutc0,ndec_early,itone_save,f1_save,xdt_save,lsubtracted, &
allmessages
this%callback => callback
@ -193,8 +192,7 @@ contains
endif
call timer('sync8 ',0)
maxc=MAXCAND
call sync8(dd,ifa,ifb,syncmin,nfqso,maxc,nzhsym,candidate, &
ncand,sbase)
call sync8(dd,ifa,ifb,syncmin,nfqso,maxc,candidate,ncand,sbase)
call timer('sync8 ',1)
do icand=1,ncand
sync=candidate(3,icand)

67
lib/get_q3list.f90 Normal file
View File

@ -0,0 +1,67 @@
subroutine get_q3list(fname,nlist,list)
type q3list
character*6 call
character*4 grid
integer nsec
integer nfreq
end type q3list
parameter (MAX_CALLERS=40)
character*(*) fname
character*36 list(40)
character*8 grid6
integer time
integer nt(8)
integer indx(MAX_CALLERS)
type(q3list) callers(MAX_CALLERS)
character*256 jpleph_file_name
common/jplcom/jpleph_file_name
nhist2=0
open(24,file=fname,status='unknown',form='unformatted')
read(24,end=1) nhist2
if(nhist2.ge.1 .and. nhist2.le.40) then
read(24,end=1) callers(1:nhist2)
else
nhist2=0
endif
1 close(24)
now=time()
call date_and_time(values=nt)
uth=nt(5) + (nt(6)-nt(4))/60.0 + nt(7)/3600.0
nlist=nhist2
call indexx(callers(1:nlist)%nfreq,nlist,indx)
do i=1,nlist
age=(now - callers(i)%nsec)/3600.0
j=indx(i)
grid6=callers(j)%grid//'mm'
call grid2deg(grid6,xlon,xlat)
call sun(nt(1),nt(2),nt(3),uth,-xlon,xlat,RASun,DecSun,xLST, &
AzSun,ElSun,mjd,day)
call moondopjpl(nt(1),nt(2),nt(3),uth,-xlon,xlat,RAMoon,DecMoon, &
xLST,HA,AzMoon,ElMoon,vr,techo)
moon_el=nint(ElMoon)
write(list(i),1000) i,callers(j)%nfreq,callers(j)%call, &
callers(j)%grid,moon_el,age,char(0)
1000 format(i2,'.',i6,2x,a6,2x,a4,i5,f7.1,a1)
h1=mod(now,86400)/3600.0
h2=mod(callers(i)%nsec,86400)/3600.0
hd=h1-h2
if(hd.lt.0.0) hd=hd+24.0
! write(*,3301) i,callers(i)%call,now,callers(i)%nsec,h1,h2,hd
!3301 format(i3,2x,a6,2i12,3f10.6)
enddo
return
end subroutine get_q3list
subroutine jpl_setup(fname)
character*256 fname,jpleph_file_name
common/jplcom/jpleph_file_name
jpleph_file_name=fname
return
end subroutine jpl_setup

13
lib/map65_mmdec.f90
View File

@ -1,5 +1,5 @@
subroutine map65_mmdec(nutc,id2,nqd,nsubmode,nfa,nfb,nfqso,ntol,newdat, &
nagain,max_drift,mycall,hiscall,hisgrid)
nagain,max_drift,ndepth,mycall,hiscall,hisgrid)
use prog_args
use timer_module, only: timer
@ -14,8 +14,8 @@ subroutine map65_mmdec(nutc,id2,nqd,nsubmode,nfa,nfb,nfqso,ntol,newdat, &
logical single_decode,bVHF,lnewdat,lagain,lclearave,lapcqonly
integer*2 id2(300*12000)
integer nqf(20)
! type(params_block) :: params
character(len=20) :: datetime
character(len=12) :: mycall, hiscall
character(len=6) :: hisgrid
data ntr0/-1/
@ -28,8 +28,7 @@ subroutine map65_mmdec(nutc,id2,nqd,nsubmode,nfa,nfb,nfqso,ntol,newdat, &
! hiscall=transfer(params%hiscall,hiscall)
! mygrid=transfer(params%mygrid,mygrid)
! hisgrid=transfer(params%hisgrid,hisgrid)
datetime=' '
my_q65%decoded = 0
ncontest=0
nQSOprogress=0
@ -40,16 +39,12 @@ subroutine map65_mmdec(nutc,id2,nqd,nsubmode,nfa,nfb,nfqso,ntol,newdat, &
lagain=(nagain.ne.0)
bVHF=.true.
emedelay=2.5
ndepth=1
ntrperiod=60
open(17,file=trim(temp_dir)//'/red.dat',status='unknown')
open(14,file=trim(temp_dir)//'/avemsg.txt',status='unknown')
call timer('dec_q65 ',0)
call my_q65%decode(q65_decoded,id2,nqd,nutc,ntrperiod,nsubmode,nfqso, &
ntol,ndepth,nfa,nfb,lclearave,single_decode,lagain,max_drift,lnewdat, &
emedelay,mycall,hiscall,hisgrid,nQSOProgress,ncontest,lapcqonly,navg0)
emedelay,mycall,hiscall,hisgrid,nQSOProgress,ncontest,lapcqonly,navg0,nqf)
call timer('dec_q65 ',1)
return

195
lib/q65_decode.f90
View File

@ -33,7 +33,7 @@ contains
subroutine decode(this,callback,iwave,nqd0,nutc,ntrperiod,nsubmode,nfqso, &
ntol,ndepth,nfa0,nfb0,lclearave,single_decode,lagain,max_drift0, &
lnewdat0,emedelay,mycall,hiscall,hisgrid,nQSOprogress,ncontest, &
lapcqonly,navg0)
lapcqonly,navg0,nqf)
! Top-level routine that organizes the decoding of Q65 signals
! Input: iwave Raw data, i*2
@ -55,9 +55,13 @@ contains
use, intrinsic :: iso_c_binding
use q65 !Shared variables
use prog_args
use types
parameter (NMAX=300*12000) !Max TRperiod is 300 s
parameter (NMAX=300*12000) !Max TRperiod is 300 s
parameter (MAX_CALLERS=40) !For multiple q3 decodes in NA VHf Contest mode
class(q65_decoder), intent(inout) :: this
procedure(q65_decode_callback) :: callback
character(len=12) :: mycall, hiscall !Used for AP decoding
character(len=6) :: hisgrid
@ -70,19 +74,26 @@ contains
character*80 fmt
integer*2 iwave(NMAX) !Raw data
real, allocatable :: dd(:) !Raw data
real xdtdecodes(100)
real f0decodes(100)
integer dat4(13) !Decoded message as 12 6-bit integers
integer dgen(13)
integer nqf(20)
integer stageno !Added by W3SZ
integer time
logical lclearave,lnewdat0,lapcqonly,unpk77_success
logical single_decode,lagain
complex, allocatable :: c00(:) !Analytic signal, 6000 Sa/s
complex, allocatable :: c0(:) !Analytic signal, 6000 Sa/s
integer stageno !Added by W3SZ
stageno=0
type(q3list) callers(MAX_CALLERS)
! Start by setting some parameters and allocating storage for large arrays
call sec0(0,tdecode)
stageno=0
ndecodes=0
decodes=' '
f0decodes=0.
xdtdecodes=0.
nfa=nfa0
nfb=nfb0
nqd=nqd0
@ -97,9 +108,30 @@ contains
nfft1=ntrperiod*12000
nfft2=ntrperiod*6000
npasses=1
nhist2=0
if(lagain) ndepth=ior(ndepth,3) !Use 'Deep' for manual Q65 decodes
dxcall13=hiscall ! initialize for use in packjt77
mycall13=mycall
if(ncontest.eq.1) then
! NA VHF, WW-Digi, or ARRL Digi Contest
open(24,file=trim(data_dir)//'/tsil.3q',status='unknown', &
form='unformatted')
read(24,end=2) nhist2
if(nhist2.ge.1 .and. nhist2.le.40) then
read(24,end=2) callers(1:nhist2)
now=time()
do i=1,nhist2
hours=(now - callers(i)%nsec)/3600.0
if(hours.gt.24.0) then
callers(i:nhist2-1)=callers(i+1:nhist2)
nhist2=nhist2-1
endif
enddo
else
nhist2=0
endif
2 close(24)
endif
! Determine the T/R sequence: iseq=0 (even), or iseq=1 (odd)
n=nutc
@ -132,25 +164,37 @@ contains
baud=12000.0/nsps
this%callback => callback
nFadingModel=1
maxiters=33
ibwa=max(1,int(1.8*log(baud*mode_q65)) + 1)
ibwb=min(10,ibwa+2)
if(iand(ndepth,3).ge.2) then
ibwa=max(1,int(1.8*log(baud*mode_q65)) + 1)
ibwb=min(10,ibwa+5)
maxiters=67
endif
! ibwa=max(1,int(1.8*log(baud*mode_q65)) + 5)
!### This needs work!
ibwa=1 !Q65-60A
if(mode_q65.eq.2) ibwa=3 !Q65-60B
if(mode_q65.eq.4) ibwa=8 !Q65-60C
if(mode_q65.eq.2) ibwa=9 !Q65-60D
if(mode_q65.eq.2) ibwa=10 !Q65-60E
!###
! ibwb=min(15,ibwa+4)
ibwb=min(15,ibwa+6)
maxiters=40
if(iand(ndepth,3).eq.2) maxiters=60
if(iand(ndepth,3).eq.3) then
ibwa=max(1,ibwa-1)
ibwb=min(10,ibwb+1)
ibwa=max(1,ibwa-2)
ibwb=ibwb+2
maxiters=100
endif
! Generate codewords for full-AP list decoding
if(ichar(hiscall(1:1)).eq.0) hiscall=' '
if(ichar(hisgrid(1:1)).eq.0) hisgrid=' '
ncw=0
if(nqd.eq.1 .or. lagain) then
call q65_set_list(mycall,hiscall,hisgrid,codewords,ncw)
if(nqd.eq.1 .or. lagain .or. ncontest.eq.1) then
if(ncontest.eq.1) then
call q65_set_list2(mycall,hiscall,hisgrid,callers,nhist2, &
codewords,ncw)
else
call q65_set_list(mycall,hiscall,hisgrid,codewords,ncw)
endif
endif
dgen=0
call q65_enc(dgen,codewords) !Initialize the Q65 codec
@ -166,11 +210,9 @@ contains
call timer('q65_dec0',0)
! Call top-level routine in q65 module: establish sync and try for a
! q3 or q0 decode.
call q65_dec0(iavg,nutc,iwave,ntrperiod,nfqso,ntol,ndepth,lclearave, &
call q65_dec0(iavg,iwave,ntrperiod,nfqso,ntol,lclearave, &
emedelay,xdt,f0,snr1,width,dat4,snr2,idec,stageno)
call timer('q65_dec0',1)
! write(*,3001) '=a',nfqso,ntol,ndepth,xdt,f0,idec
!3001 format(a2,3i5,f7.2,f7.1,i5)
if(idec.ge.0) then
dtdec=xdt !We have a q3 or q0 decode at nfqso
@ -178,6 +220,9 @@ contains
go to 100
endif
if(ncontest.eq.1 .and. lagain .and. iand(ndepth,16).eq.16) go to 50
if(ncontest.eq.1 .and. lagain .and. iand(ndepth,16).eq.0) go to 100
! Prepare for a single-period decode with iaptype = 0, 1, 2, or 4
jpk0=(xdt+1.0)*6000 !Index of nominal start of signal
if(ntrperiod.le.30) jpk0=(xdt+0.5)*6000 !For shortest sequences
@ -200,11 +245,10 @@ contains
read(c78,1060) apsymbols
endif
call timer('q65loops',0)
call timer('q65loop1',0)
call q65_loops(c00,npts/2,nsps/2,nsubmode,ndepth,jpk0, &
xdt,f0,iaptype,xdt1,f1,snr2,dat4,idec)
call timer('q65loops',1)
! write(*,3001) '=b',nfqso,ntol,ndepth,xdt,f0,idec
call timer('q65loop1',1)
if(idec.ge.0) then
dtdec=xdt1
f0dec=f1
@ -215,11 +259,11 @@ contains
if(iand(ndepth,16).eq.0 .or. navg(iseq).lt.2) go to 100
! There was no single-transmission decode. Try for an average 'q3n' decode.
50 call timer('list_avg',0)
50 iavg=1
call timer('list_avg',0)
! Call top-level routine in q65 module: establish sync and try for a q3
! decode, this time using the cumulative 's1a' symbol spectra.
iavg=1
call q65_dec0(iavg,nutc,iwave,ntrperiod,nfqso,ntol,ndepth,lclearave, &
call q65_dec0(iavg,iwave,ntrperiod,nfqso,ntol,lclearave, &
emedelay,xdt,f0,snr1,width,dat4,snr2,idec,stageno)
call timer('list_avg',1)
@ -236,7 +280,7 @@ contains
call timer('q65_avg ',0)
iavg=2
call q65_dec0(iavg,nutc,iwave,ntrperiod,nfqso,ntol,ndepth,lclearave, &
call q65_dec0(iavg,iwave,ntrperiod,nfqso,ntol,lclearave, &
emedelay,xdt,f0,snr1,width,dat4,snr2,idec,stageno)
call timer('q65_avg ',1)
if(idec.ge.0) then
@ -250,7 +294,7 @@ contains
call timer('q65_dec0',0)
! Call top-level routine in q65 module: establish sync and try for a
! q3 or q0 decode.
call q65_dec0(iavg,nutc,iwave,ntrperiod,nfqso,ntol,ndepth,lclearave, &
call q65_dec0(iavg,iwave,ntrperiod,nfqso,ntol,lclearave, &
emedelay,xdt,f0,snr1,width,dat4,snr2,idec,stageno)
call timer('q65_dec0',1)
if(idec.ge.0) then
@ -280,15 +324,24 @@ contains
if(idupe.eq.0) then
ndecodes=min(ndecodes+1,100)
decodes(ndecodes)=decoded
call q65_snr(dat4,dtdec,f0dec,mode_q65,nused,snr2)
f0decodes(ndecodes)=f0dec
xdtdecodes(ndecodes)=dtdec
call q65_snr(dat4,dtdec,f0dec,mode_q65,snr2)
nsnr=nint(snr2)
call this%callback(nutc,snr1,nsnr,dtdec,f0dec,decoded, &
idec,nused,ntrperiod)
call q65_hist(nint(f0dec),msg0=decoded)
if(ncontest.eq.1) then
open(24,file=trim(data_dir)//'/tsil.3q',status='unknown', &
form='unformatted')
call q65_hist2(nint(f0dec),decoded,callers,nhist2)
close(24)
else
call q65_hist(nint(f0dec),msg0=decoded)
endif
if(iand(ndepth,128).ne.0 .and. .not.lagain .and. &
int(abs(f0dec-nfqso)).le.ntol ) call q65_clravg !AutoClrAvg
call sec0(1,tdecode)
open(22,file=trim(data_dir)//'/q65_decodes.dat',status='unknown', &
open(22,file=trim(data_dir)//'/q65_decodes.txt',status='unknown', &
position='append',iostat=ios)
if(ios.eq.0) then
! Save decoding parameters to q65_decoded.dat, for later analysis.
@ -298,13 +351,13 @@ contains
if(c6.eq.' ') c6='<b> '
c4=hisgrid(1:4)
if(c4.eq.' ') c4='<b> '
fmt='(i6.4,1x,a4,i5,4i2,6i3,i4,f6.2,f7.1,f6.1,f7.1,f6.2,'// &
fmt='(i6.4,1x,a4,i5,4i2,8i3,i4,f6.2,f7.1,f6.1,f7.1,f6.2,'// &
'1x,a6,1x,a6,1x,a4,1x,a)'
if(ntrperiod.le.30) fmt(5:5)='6'
if(idec.eq.3) nrc=0
write(22,fmt) nutc,cmode,nfqso,nQSOprogress,idec,idfbest,idtbest, &
ibw,ndistbest,nused,icand,ncand,nrc,ndepth,xdt,f0,snr2,plog, &
tdecode,mycall(1:6),c6,c4,trim(decoded)
ibwa,ibwb,ibw,ndistbest,nused,icand,ncand,nrc,ndepth,xdt, &
f0,snr2,plog,tdecode,mycall(1:6),c6,c4,trim(decoded)
close(22)
endif
endif
@ -317,6 +370,26 @@ contains
snr1=candidates(icand,1)
xdt= candidates(icand,2)
f0 = candidates(icand,3)
do i=1,ndecodes
fdiff=f0-f0decodes(i)
if(fdiff.gt.-baud*mode_q65 .and. fdiff.lt.65*baud*mode_q65) go to 800
enddo
!### TEST REGION
if(ncontest.eq.-1) then
call timer('q65_dec0',0)
! Call top-level routine in q65 module: establish sync and try for a
! q3 or q0 decode.
call q65_dec0(iavg,iwave,ntrperiod,nint(f0),ntol,lclearave, &
emedelay,xdt,f0,snr1,width,dat4,snr2,idec,stageno)
call timer('q65_dec0',1)
if(idec.ge.0) then
dtdec=xdt !We have a q3 or q0 decode at f0
f0dec=f0
go to 200
endif
endif
!###
jpk0=(xdt+1.0)*6000 !Index of nominal start of signal
if(ntrperiod.le.30) jpk0=(xdt+0.5)*6000 !For shortest sequences
if(jpk0.lt.0) jpk0=0
@ -329,6 +402,8 @@ contains
if(lapcqonly) npasses=1
iaptype=0
do ipass=0,npasses !Loop over AP passes
! write(*,3001) nutc,icand,ipass,f0,xdt,snr1
!3001 format('a',i5.4,2i3,3f7.1)
apmask=0 !Try first with no AP information
apsymbols=0
if(ipass.ge.1) then
@ -341,10 +416,10 @@ contains
read(c78,1060) apsymbols
endif
call timer('q65loops',0)
call timer('q65loop2',0)
call q65_loops(c00,npts/2,nsps/2,nsubmode,ndepth,jpk0, &
xdt,f0,iaptype,xdt1,f1,snr2,dat4,idec)
call timer('q65loops',1)
call timer('q65loop2',1)
! write(*,3001) '=e',nfqso,ntol,ndepth,xdt,f0,idec
if(idec.ge.0) then
dtdec=xdt1
@ -365,15 +440,24 @@ contains
if(idupe.eq.0) then
ndecodes=min(ndecodes+1,100)
decodes(ndecodes)=decoded
call q65_snr(dat4,dtdec,f0dec,mode_q65,nused,snr2)
f0decodes(ndecodes)=f0dec
call q65_snr(dat4,dtdec,f0dec,mode_q65,snr2)
nsnr=nint(snr2)
call this%callback(nutc,snr1,nsnr,dtdec,f0dec,decoded, &
idec,nused,ntrperiod)
call q65_hist(nint(f0dec),msg0=decoded)
if(ncontest.eq.1) then
open(24,file=trim(data_dir)//'/tsil.3q',status='unknown', &
form='unformatted')
call q65_hist2(nint(f0dec),decoded,callers,nhist2)
close(24)
else
call q65_hist(nint(f0dec),msg0=decoded)
endif
if(iand(ndepth,128).ne.0 .and. .not.lagain .and. &
int(abs(f0dec-nfqso)).le.ntol ) call q65_clravg !AutoClrAvg
call sec0(1,tdecode)
open(22,file=trim(data_dir)//'/q65_decodes.dat',status='unknown', &
ios=1
open(22,file=trim(data_dir)//'/q65_decodes.txt',status='unknown',&
position='append',iostat=ios)
if(ios.eq.0) then
! Save decoding parameters to q65_decoded.dat, for later analysis.
@ -383,20 +467,45 @@ contains
if(c6.eq.' ') c6='<b> '
c4=hisgrid(1:4)
if(c4.eq.' ') c4='<b> '
fmt='(i6.4,1x,a4,i5,4i2,6i3,i4,f6.2,f7.1,f6.1,f7.1,f6.2,'// &
fmt='(i6.4,1x,a4,i5,4i2,8i3,i4,f6.2,f7.1,f6.1,f7.1,f6.2,'// &
'1x,a6,1x,a6,1x,a4,1x,a)'
if(ntrperiod.le.30) fmt(5:5)='6'
if(idec.eq.3) nrc=0
write(22,fmt) nutc,cmode,nfqso,nQSOprogress,idec,idfbest,idtbest, &
ibw,ndistbest,nused,icand,ncand,nrc,ndepth,xdt,f0,snr2,plog, &
tdecode,mycall(1:6),c6,c4,trim(decoded)
write(22,fmt) nutc,cmode,nfqso,nQSOprogress,idec,idfbest, &
idtbest,ibwa,ibwb,ibw,ndistbest,nused,icand,ncand,nrc, &
ndepth,xdt,f0,snr2,plog,tdecode,mycall(1:6),c6,c4, &
trim(decoded)
close(22)
endif
endif
endif
800 continue
enddo ! icand
if(iavg.eq.0 .and.navg(iseq).ge.2 .and. iand(ndepth,16).ne.0) go to 50
900 return
900 if(ncontest.ne.1 .or. lagain) go to 999
if(ntrperiod.ne.60 .or. nsubmode.ne.0) go to 999
! This is first time here, and we're running Q65-60A in NA VHF Contest mode.
! Return a list of potential sync frequencies at which to try q3 decoding.
k=0
nqf=0
bw=baud*mode_q65*65
do i=1,ncand
! snr1=candidates(i,1)
! xdt= candidates(i,2)
f0 = candidates(i,3)
do j=1,ndecodes ! Already decoded one at or near this frequency?
fj=f0decodes(j)
if(f0.gt.fj-5.0 .and. f0.lt.fj+bw+5.0) go to 990
enddo
k=k+1
nqf(k)=nint(f0)
990 continue
enddo
999 return
end subroutine decode
end module q65_decode

165
lib/qra/q65/q65.f90
View File

@ -2,8 +2,8 @@ module q65
parameter (NSTEP=8) !Number of time bins per symbol in s1, s1a, s1b
parameter (PLOG_MIN=-242.0) !List decoding threshold
integer nsave,nlist,LL0,iz0,jz0
integer listutc(10)
integer iz0,jz0
! integer listutc(10)
integer apsym0(58),aph10(10)
integer apmask1(78),apsymbols1(78)
integer apmask(13),apsymbols(13)
@ -12,23 +12,23 @@ module q65
integer codewords(63,206)
integer ibwa,ibwb,ncw,nsps,mode_q65,nfa,nfb,nqd
integer idfbest,idtbest,ibw,ndistbest,maxiters,max_drift
integer istep,nsmo,lag1,lag2,npasses,nused,iseq,ncand,nrc
integer istep,nsmo,lag1,lag2,npasses,iseq,ncand,nrc
integer i0,j0
integer navg(0:1)
logical lnewdat
real candidates(20,3) !snr, xdt, and f0 of top candidates
real, allocatable :: s1raw(:,:) !Symbol spectra, 1/8-symbol steps
real, allocatable :: s1(:,:) !Symbol spectra w/suppressed peaks
real, allocatable :: s1w(:,:) !Symbol spectra w/suppressed peaks !w3sz added
real, allocatable :: s1w(:,:) !Symbol spectra w/suppressed peaks (W3SZ)
real, allocatable,save :: s1a(:,:,:) !Cumulative symbol spectra
real, allocatable,save :: ccf2(:) !Max CCF(freq) at any lag, single seq
real, allocatable,save :: ccf2_avg(:) !Like ccf2, but for accumulated average
real, allocatable,save :: ccf2(:) !Max CCF(freq) at any lag (orange curve)
real, allocatable,save :: ccf2_avg(:) !Like ccf2, but for avg (red curve)
real sync(85) !sync vector
real df,dtstep,dtdec,f0dec,ftol,plog,drift
contains
subroutine q65_dec0(iavg,nutc,iwave,ntrperiod,nfqso,ntol,ndepth,lclearave, &
subroutine q65_dec0(iavg,iwave,ntrperiod,nfqso,ntol,lclearave, &
emedelay,xdt,f0,snr1,width,dat4,snr2,idec,stageno)
! Top-level routine in q65 module
@ -41,7 +41,6 @@ subroutine q65_dec0(iavg,nutc,iwave,ntrperiod,nfqso,ntol,ndepth,lclearave, &
! ntrperiod T/R sequence length (s)
! nfqso Target frequency (Hz)
! ntol Search range around nfqso (Hz)
! ndepth Requested decoding depth
! lclearave Flag to clear the accumulating array
! emedelay Extra delay for EME signals
! Output: xdt Time offset from nominal (s)
@ -68,7 +67,7 @@ subroutine q65_dec0(iavg,nutc,iwave,ntrperiod,nfqso,ntol,ndepth,lclearave, &
real, allocatable :: s3(:,:) !Data-symbol energies s3(LL,63)
real, allocatable :: ccf1(:) !CCF(freq) at fixed lag (red)
data first/.true./
save first
save first,LL0
integer w3t
integer w3f
@ -76,7 +75,6 @@ subroutine q65_dec0(iavg,nutc,iwave,ntrperiod,nfqso,ntol,ndepth,lclearave, &
integer stageno
NN=63
if(nutc+ndepth.eq.-999) stop !Silence compiler warnings
! Set some parameters and allocate storage for large arrays
irc=-2
@ -95,7 +93,8 @@ subroutine q65_dec0(iavg,nutc,iwave,ntrperiod,nfqso,ntol,ndepth,lclearave, &
ftol=ntol
ia=ntol/df
ia2=max(ia,10*mode_q65,nint(100.0/df))
nsmo=int(0.7*mode_q65*mode_q65)
! nsmo=int(0.7*mode_q65*mode_q65)
nsmo=int(0.5*mode_q65*mode_q65)
if(nsmo.lt.1) nsmo=1
if(first) then !Generate the sync vector
sync=-22.0/63.0 !Sync tone OFF
@ -126,7 +125,7 @@ subroutine q65_dec0(iavg,nutc,iwave,ntrperiod,nfqso,ntol,ndepth,lclearave, &
lclearave=.false.
endif
ccf1=0.
if(iavg.eq.0) ccf2_avg=0.
if(iavg.eq.0) ccf2=0.
dtstep=nsps/(NSTEP*12000.0) !Step size in seconds
lag1=-1.0/dtstep
lag2=1.0/dtstep + 0.9999
@ -135,11 +134,13 @@ subroutine q65_dec0(iavg,nutc,iwave,ntrperiod,nfqso,ntol,ndepth,lclearave, &
if(nsps.ge.7200) j0=1.0/dtstep !Nominal start-signal index
s3=0.
! if(iavg.eq.0 .and. lnewdat) then
if(iavg.eq.0) then
call timer('q65_syms',0)
! Compute symbol spectra with NSTEP time bins per symbol
call q65_symspec(iwave,ntrperiod*12000,iz,jz,s1)
call timer('q65_syms',1)
! lnewdat=.false.
else
s1=s1a(:,:,iseq)
endif
@ -148,15 +149,15 @@ subroutine q65_dec0(iavg,nutc,iwave,ntrperiod,nfqso,ntol,ndepth,lclearave, &
ii1=max(1,i0-64)
ii2=i0-65+LL
call pctile(s1(ii1:ii2,1:jz),ii2-ii1+1*jz,45,base)
s1=s1/base
! s1=s1/base
s1raw=s1
! Apply fast AGC to the symbol spectra
s1max=20.0 !Empirical choice
do j=1,jz !### Maybe wrong way? ###
smax=maxval(s1(ii1:ii2,j))
if(smax.gt.s1max) s1(ii1:ii2,j)=s1(ii1:ii2,j)*s1max/smax
enddo
! s1max=20.0 !Empirical choice
! do j=1,jz !### Maybe wrong way? ###
! smax=maxval(s1(ii1:ii2,j))
! if(smax.gt.s1max) s1(ii1:ii2,j)=s1(ii1:ii2,j)*s1max/smax
! enddo
dat4=0
if(ncw.gt.0 .and. iavg.le.1) then
@ -178,7 +179,7 @@ subroutine q65_dec0(iavg,nutc,iwave,ntrperiod,nfqso,ntol,ndepth,lclearave, &
! Get 2d CCF and ccf2 using sync symbols only
if(iavg.eq.0) then
call timer('ccf_22a ',0)
call q65_ccf_22(s1,iz,jz,nfqso,ntol,ndepth,ntrperiod,iavg,ipk,jpk, &
call q65_ccf_22(s1,iz,jz,nfqso,ntol,iavg,ipk,jpk, &
f0a,xdta,ccf2)
call timer('ccf_22a ',1)
endif
@ -186,7 +187,7 @@ subroutine q65_dec0(iavg,nutc,iwave,ntrperiod,nfqso,ntol,ndepth,lclearave, &
! Get 2d CCF and ccf2_avg using sync symbols only
if(iavg.ge.1) then
call timer('ccf_22b ',0)
call q65_ccf_22(s1,iz,jz,nfqso,ntol,ndepth,ntrperiod,iavg,ipk,jpk, &
call q65_ccf_22(s1,iz,jz,nfqso,ntol,iavg,ipk,jpk, &
f0a,xdta,ccf2_avg)
call timer('ccf_22b ',1)
endif
@ -217,10 +218,8 @@ subroutine q65_dec0(iavg,nutc,iwave,ntrperiod,nfqso,ntol,ndepth,lclearave, &
if(i2.eq.-9999 .and. ccf1(-i).ge.0.5*smax) i2=-i
enddo
width=df*(i2-i1)
if(ncw.eq.0) ccf1=0.
call q65_write_red(iz,xdt,ccf2_avg,ccf2)
call q65_write_red(iz,xdt,ccf2_avg,ccf2) !### Need this call for WSJT-X
if(idec.lt.0 .and. (iavg.eq.0 .or. iavg.eq.2)) then
call q65_dec_q012(s3,LL,snr2,dat4,idec,decoded)
@ -291,7 +290,7 @@ subroutine q65_symspec(iwave,nmax,iz,jz,s1)
allocate(c0(0:nsps-1))
nfft=nsps
fac=1/32767.0
do j=1,jz !Compute symbol spectra at step size
do j=1,jz,2 !Compute symbol spectra at 2*step size
i1=(j-1)*istep
i2=i1+nsps-1
k=-1
@ -311,6 +310,8 @@ subroutine q65_symspec(iwave,nmax,iz,jz,s1)
do i=1,nsmo
call smo121(s1(1:iz,j),iz)
enddo
! Interpolate to fill in the skipped-over spectra.
if(j.ge.3) s1(1:iz,j-1)=0.5*(s1(1:iz,j-2)+s1(1:iz,j))
enddo
if(lnewdat) then
navg(iseq)=navg(iseq) + 1
@ -481,7 +482,7 @@ subroutine q65_ccf_85(s1,iz,jz,nfqso,ia,ia2,ipk,jpk,f0,xdt,imsg_best, &
return
end subroutine q65_ccf_85
subroutine q65_ccf_22(s1,iz,jz,nfqso,ntol,ndepth,ntrperiod,iavg,ipk,jpk, &
subroutine q65_ccf_22(s1,iz,jz,nfqso,ntol,iavg,ipk,jpk, &
f0,xdt,ccf2)
! Attempt synchronization using only the 22 sync symbols. Return ccf2
@ -489,6 +490,7 @@ subroutine q65_ccf_22(s1,iz,jz,nfqso,ntol,ndepth,ntrperiod,iavg,ipk,jpk, &
real s1(iz,jz)
real ccf2(iz) !Orange sync curve
real tmp(20,3)
real, allocatable :: xdt2(:)
real, allocatable :: s1avg(:)
integer, allocatable :: indx(:)
@ -509,11 +511,14 @@ subroutine q65_ccf_22(s1,iz,jz,nfqso,ntol,ndepth,ntrperiod,iavg,ipk,jpk, &
s1avg(i)=sum(s1(i,1:jz))
enddo
call pctile(s1avg(ia:ib),ib-ia+1,40,base0)
ccfbest=0.
ibest=0
lagpk=0
lagbest=0
idrift_max=0
idrift_best=0
do i=ia,ib
ccfmax=0.
do lag=lag1,lag2
@ -535,10 +540,13 @@ subroutine q65_ccf_22(s1,iz,jz,nfqso,ntol,ndepth,ntrperiod,iavg,ipk,jpk, &
endif
enddo ! idrift
enddo ! lag
ccf2(i)=ccfmax
xdt2(i)=lagpk*dtstep
if(ccfmax.gt.ccfbest .and. abs(i*df-nfqso).le.ftol) then
ccfbest=ccfmax
snrbest=snr
ibest=i
lagbest=lagpk
idrift_best=idrift_max
@ -556,28 +564,39 @@ subroutine q65_ccf_22(s1,iz,jz,nfqso,ntol,ndepth,ntrperiod,iavg,ipk,jpk, &
! Save parameters for best candidates
jzz=ib-ia+1
call pctile(ccf2(ia:ib),jzz,40,base)
ccf2=ccf2/base
call indexx(ccf2(ia:ib),jzz,indx)
call pctile(ccf2(ia:ib),jzz,50,ave)
call pctile(ccf2(ia:ib),jzz,84,base)
rms=base-ave
ncand=0
maxcand=20
do j=1,20
k=jzz-j+1
if(k.lt.1 .or. k.gt.iz) cycle
i=indx(k)+ia-1
if(ccf2(i).lt.3.3) exit !Candidate limit
f=i*df
i3=max(1, i-mode_q65)
i4=min(iz,i+mode_q65)
biggest=maxval(ccf2(i3:i4))
if(ccf2(i).ne.biggest) cycle
snr=(ccf2(i)-ave)/rms
if(snr.lt.6.0) exit
ncand=ncand+1
candidates(ncand,1)=ccf2(i)
candidates(ncand,1)=snr
candidates(ncand,2)=xdt2(i)
candidates(ncand,3)=f
if(ncand.ge.maxcand) exit
enddo
! Resort the candidates back into frequency order
tmp(1:ncand,1:3)=candidates(1:ncand,1:3)
candidates=0.
call indexx(tmp(1:ncand,3),ncand,indx)
do i=1,ncand
candidates(i,1:3)=tmp(indx(i),1:3)
enddo
return
end subroutine q65_ccf_22
@ -591,7 +610,7 @@ subroutine q65_dec1(s3,nsubmode,b90ts,esnodb,irc,dat4,decoded)
integer dat4(13)
character c77*77,decoded*37
logical unpk77_success
nFadingModel=1
decoded=' '
call q65_intrinsics_ff(s3,nsubmode,b90ts,nFadingModel,s3prob)
@ -605,7 +624,7 @@ subroutine q65_dec1(s3,nsubmode,b90ts,esnodb,irc,dat4,decoded)
irc=-1
endif
nrc=irc
return
end subroutine q65_dec1
@ -672,16 +691,21 @@ subroutine q65_write_red(iz,xdt,ccf2_avg,ccf2)
call q65_sync_curve(ccf2_avg,1,iz,rms1)
call q65_sync_curve(ccf2,1,iz,rms2)
i1=max(1,nint(nfa/df))
i2=min(iz,int(nfb/df))
y0=minval(ccf2(i1:i2))
y0_avg=minval(ccf2_avg(i1:i2))
g=0.4
g_avg=0.
if(navg(iseq).ge.2) g_avg=g
rewind 17
write(17,1000) xdt,minval(ccf2_avg),maxval(ccf2_avg)
do i=max(1,nint(nfa/df)),min(iz,int(nfb/df))
write(17,1000) xdt,g_avg*minval(ccf2_avg),g_avg*maxval(ccf2_avg)
do i=i1,i2
freq=i*df
y1=ccf2_avg(i)
if(y1.gt.10.0) y1=10.0 + 2.0*log10(y1/10.0)
y2=ccf2(i)
if(y2.gt.10.0) y2=10.0 + 2.0*log10(y2/10.0)
y1=g_avg*(ccf2_avg(i)-y0_avg)
y2=g*(ccf2(i)-y0)
write(17,1000) freq,y1,y2
1000 format(3f10.3)
1000 format(f10.3,2f15.6)
enddo
flush(17)
@ -733,7 +757,7 @@ subroutine q65_bzap(s3,LL)
return
end subroutine q65_bzap
subroutine q65_snr(dat4,dtdec,f0dec,mode_q65,nused,snr2)
subroutine q65_snr(dat4,dtdec,f0dec,mode_q65,snr2)
! Estimate SNR of a decoded transmission by aligning the spectra of
! all 85 symbols.
@ -781,8 +805,6 @@ subroutine q65_snr(dat4,dtdec,f0dec,mode_q65,nused,snr2)
sig_area=sum(spec(ia+nsum:ib-nsum)-1.0)
w_equiv=sig_area/(smax-1.0)
snr2=db(max(1.0,sig_area)) - db(2500.0/df)
! NB: No adjustment to SNR is now made for nused>1, because that process did
! not seem to work as expected.
return
end subroutine q65_snr
@ -841,4 +863,65 @@ subroutine q65_hist(if0,msg0,dxcall,dxgrid)
900 return
end subroutine q65_hist
subroutine q65_hist2(nfreq,msg0,callers,nhist2)
use types
use prog_args
parameter (MAX_CALLERS=40) !For multiple q3 decodes in NA VHf Contest mode
character*37 msg0,msg
type(q3list) callers(MAX_CALLERS)
character*6 c6
character*4 g4
logical newcall,isgrid
isgrid(g4)=g4(1:1).ge.'A' .and. g4(1:1).le.'R' .and. g4(2:2).ge.'A' .and. &
g4(2:2).le.'R' .and. g4(3:3).ge.'0' .and. g4(3:3).le.'9' .and. &
g4(4:4).ge.'0' .and. g4(4:4).le.'9' .and. g4(1:4).ne.'RR73'
msg=msg0
if(index(msg,'/').gt.0) goto 900 !Ignore messages withcompound calls
i0=index(msg,' R ')
if(i0.ge.7) msg=msg(1:i0)//msg(i0+3:)
i1=index(msg,' ')
c6=' '
g4=' '
if(i1.ge.4 .and. i1.le.13) then
i2=index(msg(i1+1:),' ') + i1
c6=msg(i1+1:i2-1) !Extract DX call
g4=msg(i2+1:i2+4) !Extract DX grid
endif
newcall=.true.
do i=1,nhist2
if(callers(i)%call .eq. c6) then
newcall=.false.
callers(i)%nsec=time()
exit
endif
enddo
if(newcall .and. isgrid(g4)) then
if(nhist2.eq.MAX_CALLERS) then
! Purge the oldest caller
callers(1:MAX_CALLERS-1)=callers(2:MAX_CALLERS)
nhist2=nhist2-1
endif
nhist2=nhist2+1
callers(nhist2)%call=c6
callers(nhist2)%grid=g4
callers(nhist2)%nsec=time()
callers(nhist2)%nfreq=nfreq
endif
if(nhist2.ge.1 .and. nhist2.le.40) then
open(24,file=trim(data_dir)//'/tsil.3q',status='unknown', &
form='unformatted')
write(24) nhist2
write(24) callers(1:nhist2)
close(24)
endif
900 return
end subroutine q65_hist2
end module q65

4
lib/qra/q65/q65_encoding_modules.f90
View File

@ -135,10 +135,9 @@ end
subroutine get_q65crc12(mc2,ncrc1,ncrc2)
!
character c12*12,c6*6
character c6*6
integer*1 mc(90),mc2(90),tmp(6)
integer*1 r(13),p(13)
integer ncrc
! polynomial for 12-bit CRC 0xF01
data p/1,1,0,0,0,0,0,0,0,1,1,1,1/
@ -170,7 +169,6 @@ subroutine get_q65_tones(msg37,codeword,itone)
implicit none
character*37 msg37
character*77 c77
character*12 c12
character*6 c6
integer codeword(65)
integer sync(22)

2
lib/qra/q65/q65_loops.f90
View File

@ -37,7 +37,7 @@ subroutine q65_loops(c00,npts2,nsps2,nsubmode,ndepth,jpk0, &
if(iand(ndepth,3).eq.3) then
idfmax=5
idtmax=5
maxdist=15
maxdist=5
endif
napmin=99

4
lib/qra/q65/q65_set_list.f90
View File

@ -3,7 +3,7 @@ subroutine q65_set_list(mycall,hiscall,hisgrid,codewords,ncw)
parameter (MAX_NCW=206)
character*12 mycall,hiscall
character*6 hisgrid
character*37 msg0,msg,msgsent
character*37 msg,msgsent
logical my_std,his_std
integer codewords(63,MAX_NCW)
integer itone(85)
@ -45,7 +45,7 @@ subroutine q65_set_list(mycall,hiscall,hisgrid,codewords,ncw)
endif
endif
10 call genq65(msg,0,msgsent,itone,i3,n3)
call genq65(msg,0,msgsent,itone,i3,n3)
i0=1
j=0
do k=1,85

70
lib/qra/q65/q65_set_list2.f90 Normal file
View File

@ -0,0 +1,70 @@
subroutine q65_set_list2(mycall,hiscall,hisgrid,callers,nhist2,codewords,ncw)
use types
parameter (MAX_NCW=206)
parameter (MAX_CALLERS=40) !For multiple q3 decodes in NA VHf Contest mode
character*12 mycall,hiscall
character*6 hisgrid,c6
character*4 g4
character*37 msg,msgsent
logical std,isgrid
integer codewords(63,MAX_NCW)
integer itone(85)
integer isync(22)
type(q3list) callers(MAX_CALLERS)
data isync/1,9,12,13,15,22,23,26,27,33,35,38,46,50,55,60,62,66,69,74,76,85/
isgrid(g4)=g4(1:1).ge.'A' .and. g4(1:1).le.'R' .and. g4(2:2).ge.'A' .and. &
g4(2:2).le.'R' .and. g4(3:3).ge.'0' .and. g4(3:3).le.'9' .and. &
g4(4:4).ge.'0' .and. g4(4:4).le.'9' .and. g4(1:4).ne.'RR73'
call stdcall(hiscall,std)
jmax=nhist2
if(std .and. isgrid(hisgrid(1:4))) then
jmax=nhist2+1
do j=1,nhist2
if(callers(j)%call .eq. hiscall(1:6)) then
jmax=nhist2
exit
endif
enddo
endif
codewords(:,1)=0
i=1
do j=1,jmax
c6=callers(j)%call
g4=callers(j)%grid
if(j.eq.nhist2+1) then
c6=hiscall(1:6)
g4=hisgrid(1:4)
endif
do k=1,5
i=i+1
msg=trim(mycall)//' '//trim(c6)
j0=len(trim(msg))+1
if(k.eq.1) msg=msg(1:j0)//g4
if(k.eq.2) msg=msg(1:j0)//'R '//g4
if(k.eq.3) msg(j0:j0+3)=' RRR'
if(k.eq.4) msg(j0:j0+4)=' RR73'
if(k.eq.5) msg(j0:j0+2)=' 73'
call genq65(msg,0,msgsent,itone,i3,n3)
i0=1
jj=0
do kk=1,85
if(kk.eq.isync(i0)) then
i0=i0+1
cycle
endif
jj=jj+1
codewords(jj,i)=itone(kk) - 1
enddo
! write(71,3001) i,j,k,codewords(1:13,i),trim(msg)
!3001 format(3i3,2x,13i3,2x,a)
enddo
enddo
ncw=i
return
end subroutine q65_set_list2

124
lib/qra/q65/q65sim.f90
View File

@ -8,6 +8,7 @@ program q65sim
type(hdr) h !Header for .wav file
integer*2 iwave(NMAX) !Generated waveform
integer itone(85) !Channel symbols (values 0-65)
integer ntone(85,10) !Channel symbols for up to 10 messages
integer y(63) !Codeword
integer istart !averaging compatible start seconds
integer imins !minutes for 15s period timestamp
@ -17,19 +18,20 @@ program q65sim
complex cdat(NMAX) !Generated complex waveform
complex cspread(0:NMAX-1) !Complex amplitude for Rayleigh fading
complex z
real*8 f0,dt,twopi,phi,dphi,baud,fsample,freq
character msg*37,fname*17,csubmode*1,arg*12
character msgsent*37
real*8 f00,f0,dt,twopi,phi,dphi,baud,fsample,freq
character fname*17,csubmode*1,arg*12,c2*2
character*37 msg,msgsent,imsg(10)
nargs=iargc()
if(nargs.ne.10) then
print*,'Usage: q65sim "msg" A-E freq fDop DT f1 Stp TRp Nfile SNR'
print*,'Example: q65sim "K1ABC W9XYZ EN37" A 1500 0.0 0.0 0.0 1 60 1 -26'
if(nargs.ne.11) then
print*,'Usage: q65sim "msg" A-E freq fDop DT f1 Stp TRp Nsig Nfile SNR'
print*,'Example: q65sim "K1ABC W9XYZ EN37" A 1500 0.0 0.0 0.0 1 60 1 1 -26'
print*,'Example: q65sim "ST" A 1500 0.0 0.0 0.0 1 60 1 -26'
print*,' fDop = Doppler spread'
print*,' f1 = Drift or Doppler rate (Hz/min)'
print*,' Stp = Step size (Hz)'
print*,' Stp = 0 implies no Doppler tracking'
print*,' Nsig = number of generated signals, 1 - 10'
print*,' Creates filenames which increment to permit averaging in first period'
print*,' If msg = ST program produces a single tone at freq'
go to 999
@ -38,7 +40,7 @@ program q65sim
call getarg(2,csubmode)
mode65=2**(ichar(csubmode)-ichar('A'))
call getarg(3,arg)
read(arg,*) f0
read(arg,*) f00
call getarg(4,arg)
read(arg,*) fspread
call getarg(5,arg)
@ -50,8 +52,10 @@ program q65sim
call getarg(8,arg)
read(arg,*) ntrperiod
call getarg(9,arg)
read(arg,*) nfiles
read(arg,*) nsig
call getarg(10,arg)
read(arg,*) nfiles
call getarg(11,arg)
read(arg,*) snrdb
if(ntrperiod.eq.15) then
@ -79,22 +83,39 @@ program q65sim
nsym=85 !Number of channel symbols
mode65=2**(ichar(csubmode) - ichar('A'))
ichk=0
call genq65(msg,ichk,msgsent,itone,i3,n3)
imsg(1)=msg
if(nsig.ge.2) then
i0=index(msg,' ')
i0=i0 + index(msg(i0+1:),' ')-2
do i=1,nsig
c2=char(ichar('A')+i-1)//char(ichar('A')+i-1)
imsg(i)=msg(1:i0-1)//c2//msg(i0+2:)
enddo
endif
j=0
do i=1,85
if(itone(i).gt.0) then
j=j+1
y(j)=itone(i)-1
endif
ichk=0
do i=1,nsig
msg=imsg(i)
call genq65(msg,ichk,msgsent,itone,i3,n3)
ntone(:,i)=itone
enddo
write(*,1001) y(1:13),y(1:13)
if(nsig.eq.1) then
j=0
do i=1,85
if(itone(i).gt.0) then
j=j+1
y(j)=itone(i)-1
endif
enddo
write(*,1001) y(1:13),y(1:13)
1001 format('Generated message'/'6-bit: ',13i3/'binary: ',13b6.6)
write(*,1002) y
write(*,1002) y
1002 format(/'Codeword:'/(20i3))
write(*,1003) itone
write(*,1003) itone
1003 format(/'Channel symbols:'/(20i3))
endif
baud=12000.d0/nsps !Keying rate (6.67 baud fot 15-s sequences)
h=default_header(12000,npts)
@ -116,43 +137,54 @@ program q65sim
open(10,file=trim(fname),access='stream',status='unknown')
xnoise=0.
cdat=0.
if(snrdb.lt.90) then
do i=1,npts
xnoise(i)=gran() !Generate gaussian noise
enddo
endif
cdat=0.
bandwidth_ratio=2500.0/6000.0
sig=sqrt(2*bandwidth_ratio)*10.0**(0.05*snrdb)
if(snrdb.gt.90.0) sig=1.0
write(*,1020) ifile,ntrperiod,f0,csubmode,snrdb,fspread,xdt,f1,nstp,trim(msgsent)
1020 format(i4,i6,f7.1,2x,a1,2x,f5.1,1x,f6.2,2f6.1,i4,2x,a)
phi=0.d0
dphi=0.d0
k=(xdt+0.5)*12000 !Start audio at t=xdt+0.5 s (TR=15 and 30 s)
if(ntrperiod.ge.60) k=(xdt+1.0)*12000 !TR 60+ at t = xdt + 1.0 s
isym0=-99
do i=1,npts !Add this signal into cdat()
isym=i/nsps + 1
if(isym.gt.nsym) exit
if(isym.ne.isym0) then
freq_drift=f1*i*dt/60.0
if(nstp.ne.0) freq_drift=freq_drift - nstp*nint(freq_drift/nstp)
if (msg(1:2).eq.'ST') then
freq = f0 + freq_drift
else
freq = f0 + freq_drift + itone(isym)*baud*mode65
endif
dphi=twopi*freq*dt
isym0=isym
write(*,1020) ifile,ntrperiod,f00,csubmode,snrdb,fspread,xdt,f1,nstp,trim(msgsent)
1020 format(i4,i6,f7.1,2x,a1,2x,f5.1,1x,f6.2,2f6.1,i4,2x,a)
n=65.0*baud*mode65/100.0 + 0.9999
nfstep=100*n
nf1=1500 - nfstep*(nsig-1)/2
do n=1,nsig
if(nsig.ge.2) then
f0=f00
f0=nf1 + (n-1)*nfstep
itone=ntone(:,n)
endif
phi=phi + dphi
if(phi.gt.twopi) phi=phi-twopi
xphi=phi
z=cmplx(cos(xphi),sin(xphi))
k=k+1
if(k.ge.1) cdat(k)=cdat(k) + sig*z
phi=0.d0
dphi=0.d0
k=(xdt+0.5)*12000 !Start audio at t=xdt+0.5 s (TR=15 and 30 s)
if(ntrperiod.ge.60) k=(xdt+1.0)*12000 !TR 60+ at t = xdt + 1.0 s
isym0=-99
do i=1,npts !Add this signal into cdat()
isym=i/nsps + 1
if(isym.gt.nsym) exit
if(isym.ne.isym0) then
freq_drift=f1*i*dt/60.0
if(nstp.ne.0) freq_drift=freq_drift - nstp*nint(freq_drift/nstp)
if (msg(1:2).eq.'ST') then
freq = f0 + freq_drift
else
freq = f0 + freq_drift + itone(isym)*baud*mode65
endif
dphi=twopi*freq*dt
isym0=isym
endif
phi=phi + dphi
if(phi.gt.twopi) phi=phi-twopi
xphi=phi
z=cmplx(cos(xphi),sin(xphi))
k=k+1
if(k.ge.1) cdat(k)=cdat(k) + sig*z
enddo
enddo
if(fspread.ne.0) then !Apply specified Doppler spread

2
lib/sumsim.f90
View File

@ -35,7 +35,7 @@ program sumsim
fac=1.0/nargs
iwave(1:npts)=nint(fac*wave(1:npts))
open(12,file='000000_0000.wav',access='stream',status='unknown')
open(12,file='000001_0000.wav',access='stream',status='unknown')
write(12) h,iwave(1:npts)
close(12)

129
lib/test_qra64.f90
View File

@ -1,129 +0,0 @@
program test_qra64
character*71 cmd1,cmd2,line
character*22 msg
character*8 arg
character*1 csubmode
integer nretcode(0:11)
logical decok
nargs=iargc()
if(nargs.ne.9) then
print*,'Usage: test_qra64 "msg" A-D depth freq DT fDop TRp nfiles SNR'
print*,'Example: test_qra64 "K1ABC W9XYZ EN37" A 3 1000 0.0 5.0 60 100 -20'
print*,' SNR = 0 to loop over all relevant SNRs'
go to 999
endif
call getarg(1,msg)
call getarg(2,csubmode)
call getarg(3,arg)
read(arg,*) ndepth
call getarg(4,arg)
read(arg,*) nf0
call getarg(5,arg)
read(arg,*) dt
call getarg(6,arg)
read(arg,*) fDop
call getarg(7,arg)
read(arg,*) ntrperiod
call getarg(8,arg)
read(arg,*) nfiles
call getarg(9,arg)
read(arg,*) nsnr
nsps=6192
i50=-28
ia=-20
ib=-33
if(nsnr.ne.0) then
ia=nsnr
ib=nsnr
endif
baud=12000.0/nsps
tsym=1.0/baud
! 1 2 3 4 5 6 7
! 12345678901234567890123456789012345678901234567890123456789012345678901'
cmd1='qra64sim "K1ABC W9XYZ EN37 " A 1 0.2 0.00 100 F -20 > junk0'
cmd2='jt9 -q -L 300 -H 3000 -f 1000 -d 3 -b A *.wav > junk'
write(cmd1(10:33),'(a)') '"'//msg//'"'
cmd1(35:35)=csubmode
write(cmd1(40:43),'(f4.1)') fDop
write(cmd1(44:48),'(f5.2)') dt
write(cmd1(49:53),'(i5)') nfiles
write(cmd2(26:29),'(i4)') nf0
write(cmd2(34:34),'(i1)') ndepth
cmd2(39:39)=csubmode
call system('rm -f *.wav')
write(*,1000) (j,j=0,11)
write(12,1000) (j,j=0,11)
1000 format(/'SNR d Dop Sync Dec Bad',i6,11i4,' tdec'/80('-'))
dterr=tsym/4.0
nferr=max(1,nint(0.5*baud),nint(fdop/3.0))
ndecodes0=nfiles
do nsnr=ia,ib,-1
nsync=0
ndecodes=0
nfalse=0
nretcode=0
write(cmd1(57:59),'(i3)') nsnr
call system(cmd1)
call sec0(0,tdec)
call system(cmd2)
call sec0(1,tdec)
open(10,file='junk',status='unknown')
n=0
do iline=1,9999
read(10,'(a71)',end=10) line
if(index(line,'<Decode').eq.1) cycle
read(line(11:20),*) xdt,nf
irc=-1
if(line(23:23).ne.' ') read(line(45:46),*) irc
decok=index(line,'W9XYZ').gt.0
if((abs(xdt-dt).le.dterr .and. abs(nf-nf0).le.nferr) .or. decok) then
nsync=nsync+1
endif
if(irc.lt.0) cycle
if(decok) then
i=irc
if(i.le.11) then
ndecodes=ndecodes + 1
else
i=mod(i,10)
endif
nretcode(i)=nretcode(i) + 1
else
nfalse=nfalse + 1
print*,'False: ',line
endif
enddo ! iline
10 close(10)
write(*,1100) nsnr,ndepth,fDop,nsync,ndecodes,nfalse,nretcode, &
tdec/nfiles
write(12,1100) nsnr,ndepth,fDop,nsync,ndecodes,nfalse,nretcode, &
tdec/nfiles
1100 format(i3,i2,f5.1,2i5,i4,i6,11i4,f6.2)
if(ndecodes.lt.nfiles/2 .and. ndecodes0.ge.nfiles/2) then
snr_thresh=nsnr + float(nfiles/2 - ndecodes)/(ndecodes0-ndecodes)
write(13,1200) ndepth,fdop,csubmode,snr_thresh
1200 format(i1,f6.1,2x,a1,f7.1)
flush(13)
endif
flush(6)
flush(12)
if(ndecodes.eq.0) exit !Bail out if no decodes at this SNR
ndecodes0=ndecodes
enddo ! nsnr
999 end program test_qra64
include 'sec0.f90'

7
lib/types.f90
View File

@ -7,4 +7,11 @@ module types
integer, parameter :: dp = REAL64
integer, parameter :: qp = REAL128
type q3list
character*6 call
character*4 grid
integer nsec
integer nfreq
end type q3list
end module types

3
map65/astro.cpp
View File

@ -63,13 +63,14 @@ void Astro::astroUpdate(QDateTime t, QString mygrid, QString hisgrid,
int isec=sec;
double uth=nhr + nmin/60.0 + sec/3600.0;
int nfreq=(int)datcom_.fcenter;
if(nfreq<10 or nfreq > 50000) nfreq=144;
// if(nfreq<10 or nfreq > 50000) nfreq=144;
astrosub_(&nyear, &month, &nday, &uth, &nfreq, mygrid.toLatin1(),
hisgrid.toLatin1(), &azsun, &elsun, &azmoon, &elmoon,
&azmoondx, &elmoondx, &ntsky, &ndop, &ndop00,&ramoon, &decmoon,
&dgrd, &poloffset, &xnr, 6, 6);
datcom_.nfast=ndop00; //Send self Doppler to decoder, via datcom
sprintf(cc,
"Az: %6.1f\n"
"El: %6.1f\n"

12
map65/libm65/astrosub.f90
View File

@ -12,3 +12,15 @@ subroutine astrosub(nyear,month,nday,uth8,nfreq,mygrid,hisgrid, &
return
end subroutine astrosub
subroutine astrosub00(nyear,month,nday,uth8,nfreq,mygrid,ndop00)
implicit real*8 (a-h,o-z)
character*6 mygrid
call astrosub(nyear,month,nday,uth8,nfreq,mygrid,mygrid, &
AzSun8,ElSun8,AzMoon8,ElMoon8,AzMoonB8,ElMoonB8,ntsky,ndop,ndop00, &
RAMoon8,DecMoon8,Dgrd8,poloffset8,xnr8)
return
end subroutine astrosub00

4
map65/libm65/decode0.f90
View File

@ -12,7 +12,7 @@ subroutine decode0(dd,ss,savg,nstandalone)
common/npar/fcenter,nutc,idphi,mousedf,mousefqso,nagain, &
ndepth,ndiskdat,neme,newdat,nfa,nfb,nfcal,nfshift, &
mcall3,nkeep,ntol,nxant,nrxlog,nfsample,nxpol,nmode, &
nfast,nsave,max_drift,nhsym,mycall,mygrid,hiscall,hisgrid,datetime
ndop00,nsave,max_drift,nhsym,mycall,mygrid,hiscall,hisgrid,datetime
common/early/nhsym1,nhsym2,ldecoded(32768)
common/decodes/ndecodes
data neme0/-99/,mcall3b/1/
@ -56,7 +56,7 @@ subroutine decode0(dd,ss,savg,nstandalone)
mousedf,mousefqso,nagain,ndecdone,nfshift,ndphi,max_drift, &
nfcal,nkeep,mcall3b,nsum,nsave,nxant,mycall,mygrid, &
neme,ndepth,nstandalone,hiscall,hisgrid,nhsym,nfsample, &
ndiskdat,nxpol,nmode)
ndiskdat,nxpol,nmode,ndop00)
call timer('map65a ',1)
call timer('decode0 ',1)

1
map65/libm65/ftninit.f90
View File

@ -10,6 +10,7 @@ subroutine ftninit(appd)
addpfx=' '
call pfxdump(appd//'/prefixes.txt')
open(12,file=appd//'/wb_q65.txt',status='unknown')
open(13,file=appd//'/map65.log',status='unknown')
open(19,file=appd//'/livecq.txt',status='unknown')
open(21,file=appd//'/map65_rx.log',status='unknown',access='append',err=950)

6
map65/libm65/m65.f90
View File

@ -7,9 +7,9 @@ program m65
!
! 10 binary input data, *.tf2 files
! 11 prefixes.txt
! 12
! 12 wb_w65.txt
! 13 map65.log
! 14
! 14
! 15
! 16 tquick log
! 17 saved *.tf2 files
@ -41,7 +41,7 @@ program m65
common/npar/fcenter,nutc,idphi,mousedf,mousefqso,nagain, &
ndepth,ndiskdat,neme,newdat,nfa,nfb,nfcal,nfshift, &
mcall3,nkeep,ntol,nxant,nrxlog,nfsample,nxpol,nmode, &
nfast,nsave,max_drift,nhsym,mycall,mygrid,hiscall,hisgrid,datetime
ndop00,nsave,max_drift,nhsym,mycall,mygrid,hiscall,hisgrid,datetime
common/early/nhsym1,nhsym2,ldecoded(32768)
nargs=iargc()

2
map65/libm65/m65a.f90
View File

@ -82,7 +82,7 @@ subroutine m65c(dd,ss,savg,nparams0)
common/npar/fcenter,nutc,idphi,mousedf,mousefqso,nagain, &
ndepth,ndiskdat,neme,newdat,nfa,nfb,nfcal,nfshift, &
mcall3,nkeep,ntol,nxant,nrxlog,nfsample,nxpol,nmode, &
nfast,nsave,max_drift,nhsym,mycall,mygrid,hiscall,hisgrid, &
ndop00,nsave,max_drift,nhsym,mycall,mygrid,hiscall,hisgrid, &
datetime,junk1,junk2
common/early/nhsym1,nhsym2,ldecoded(32768)
equivalence (nparams,fcenter)

16
map65/libm65/map65a.f90
View File

@ -2,7 +2,7 @@ subroutine map65a(dd,ss,savg,newdat,nutc,fcenter,ntol,idphi,nfa,nfb, &
mousedf,mousefqso,nagain,ndecdone,nfshift,ndphi,max_drift, &
nfcal,nkeep,mcall3b,nsum,nsave,nxant,mycall,mygrid, &
neme,ndepth,nstandalone,hiscall,hisgrid,nhsym,nfsample, &
ndiskdat,nxpol,nmode)
ndiskdat,nxpol,nmode,ndop00)
! Processes timf2 data from Linrad to find and decode JT65 signals.
@ -41,6 +41,7 @@ subroutine map65a(dd,ss,savg,newdat,nutc,fcenter,ntol,idphi,nfa,nfb, &
data nfile/0/,nutc0/-999/,nid/0/,ip000/1/,ip001/1/,mousefqso0/-999/
save
rewind 12
ndecodes=0
! Clean start for Q65 at early decode
@ -68,11 +69,11 @@ subroutine map65a(dd,ss,savg,newdat,nutc,fcenter,ntol,idphi,nfa,nfb, &
endif
!###
! do k=1,ncand
! freq=cand(k)%f+nkhz_center-48.0-1.27046
! freq=cand(k)%f+nkhz_center-48.0
! ipk=cand(k)%indx
! write(*,3010) nutc,k,db(cand(k)%snr),freq,cand(k)%xdt, &
! write(71,3071) k,db(cand(k)%snr),freq,cand(k)%xdt, &
! cand(k)%ipol,cand(k)%iflip,ipk,ldecoded(ipk)
!3010 format('=a',i5.4,i5,f8.2,f10.3,f8.2,2i3,i6,L4)
!3071 format(i3,f8.2,f10.3,f8.2,2i3,i6,L4)
! enddo
!###
@ -365,7 +366,7 @@ subroutine map65a(dd,ss,savg,newdat,nutc,fcenter,ntol,idphi,nfa,nfb, &
call timer('q65b ',0)
call q65b(nutc,nqd,nxant,fcenter,nfcal,nfsample,ikhz,mousedf, &
ntol,xpol,mycall,mygrid, hiscall,hisgrid,mode_q65,f0,fqso, &
newdat,nagain,max_drift,nhsym,idec)
newdat,nagain,max_drift,nhsym,ndop00,idec)
call timer('q65b ',1)
if(idec.ge.0) candec(icand)=.true.
enddo
@ -376,7 +377,7 @@ subroutine map65a(dd,ss,savg,newdat,nutc,fcenter,ntol,idphi,nfa,nfb, &
call timer('q65b ',0)
call q65b(nutc,nqd,nxant,fcenter,nfcal,nfsample,ikhz,mousedf, &
ntol,xpol,mycall,mygrid,hiscall,hisgrid,mode_q65,f0,fqso, &
newdat,nagain,max_drift,nhsym,idec)
newdat,nagain,max_drift,nhsym,ndop00,idec)
call timer('q65b ',1)
endif
endif
@ -420,7 +421,7 @@ subroutine map65a(dd,ss,savg,newdat,nutc,fcenter,ntol,idphi,nfa,nfb, &
call timer('q65b ',0)
call q65b(nutc,nqd,nxant,fcenter,nfcal,nfsample,ikhz,mousedf,ntol, &
xpol,mycall,mygrid,hiscall,hisgrid,mode_q65,f0,fqso,newdat, &
nagain,max_drift,nhsym,idec)
nagain,max_drift,nhsym,ndop00,idec)
call timer('q65b ',1)
if(idec.ge.0) candec(icand)=.true.
enddo ! icand
@ -520,6 +521,7 @@ subroutine map65a(dd,ss,savg,newdat,nutc,fcenter,ntol,idphi,nfa,nfb, &
ndecdone=2
900 close(23)
call flush(12)
ndphi=0
mcall3b=mcall3a

11
map65/libm65/q65b.f90
View File

@ -1,6 +1,6 @@
subroutine q65b(nutc,nqd,nxant,fcenter,nfcal,nfsample,ikhz,mousedf,ntol,xpol, &
mycall0,mygrid,hiscall0,hisgrid,mode_q65,f0,fqso,newdat,nagain, &
max_drift,nhsym,idec)
max_drift,nhsym,ndop00,idec)
! This routine provides an interface between MAP65 and the Q65 decoder
! in WSJT-X. All arguments are input data obtained from the MAP65 GUI.
@ -181,11 +181,16 @@ subroutine q65b(nutc,nqd,nxant,fcenter,nfcal,nfsample,ikhz,mousedf,ntol,xpol, &
if(nutc.ne.nutc00 .or. msg0(1:28).ne.msg00 .or. freq1.ne.freq1_00) then
! Write to file map65_rx.log:
ndecodes=ndecodes+1
write(21,1110) freq1,ndf,xdt0,npol,nsnr0,nutc,msg0(1:28),cq0
1110 format(f8.3,i5,f5.1,2i4,i5.4,2x,a28,': A',2x,a3)
write(21,1110) freq1,ndf,xdt0,npol,nsnr0,nutc,msg0(1:28), &
cmode(2:2),cq0
1110 format(f8.3,i5,f5.1,2i4,i5.4,2x,a28,': ',a1,2x,a3)
nutc00=nutc
msg00=msg0(1:28)
freq1_00=freq1
frx=0.001*k0*df+nkhz_center-48.0+1.0 - 0.001*nfcal
fsked=frx - 0.001*ndop00/2.0 - 1.5
write(12,1120) nutc,fsked,xdt0,nsnr0,trim(msg0)
1120 format(i4.4,f9.3,f7.2,i5,2x,a,i6)
endif
endif

33
map65/libm65/wideband_sync.f90
View File

@ -41,7 +41,7 @@ subroutine get_candidates(ss,savg,xpol,jz,nfa,nfb,nts_jt65,nts_q65,cand,ncand)
type(candidate) :: cand(MAX_CANDIDATES)
common/early/nhsym1,nhsym2,ldecoded(32768)
call wb_sync(ss,savg,xpol,jz,nfa,nfb)
call wb_sync(ss,savg,xpol,jz,nfa,nfb) !Output to sync() array
tstep=2048.0/11025.0 !0.185760 s: 0.5*tsym_jt65, 0.3096*tsym_q65
df3=96000.0/NFFT
@ -89,8 +89,6 @@ subroutine get_candidates(ss,savg,xpol,jz,nfa,nfb,nts_jt65,nts_q65,cand,ncand)
if(diffhz.gt.-0.03*bw .and. diffhz.lt.1.03*bw) skip=.true.
enddo
if(skip) cycle
! write(*,3301) i,k,m,f0,diffhz,bw,db(snr1)
!3301 format('=A',3i5,f8.3,2f8.0,f8.2)
k=k+1
cand(k)%snr=snr1
cand(k)%f=f0
@ -99,6 +97,8 @@ subroutine get_candidates(ss,savg,xpol,jz,nfa,nfb,nts_jt65,nts_q65,cand,ncand)
cand(k)%ipol=sync(n)%ipol
cand(k)%iflip=nint(flip)
cand(k)%indx=n
! write(50,3050) i,k,m,f0+32.0,diffhz,bw,snr1,db(snr1)
!3050 format(3i5,f8.3,2f8.0,2f8.2)
if(k.ge.MAX_CANDIDATES) exit
enddo
ncand=k
@ -251,15 +251,30 @@ subroutine wb_sync(ss,savg,xpol,jz,nfa,nfb)
enddo ! i (frequency bin)
! do i=ia,ib
! write(15,3015) 0.001*(i-1)*df3,sync(i)%ccfmax,sync(i)%xdt,sync(i)%ipol, &
! sync(i)%iflip,sync(i)%birdie
!3015 format(3f10.3,2i6,L5)
! enddo
call pctile(sync(ia:ib)%ccfmax,ib-ia+1,50,base)
sync(ia:ib)%ccfmax=sync(ia:ib)%ccfmax/base
bw=65*4*1.66666667 !Q65-60C bandwidth
nbw=bw/df3 + 1 !Number of bins to blank
syncmin=2.0
nguard=10
do i=ia,ib
if(sync(i)%ccfmax.lt.syncmin) cycle
spk=maxval(sync(i:i+nbw)%ccfmax)
ip =maxloc(sync(i:i+nbw)%ccfmax)
i0=ip(1)+i-1
ja=min(i,i0-nguard)
jb=i0+nbw+nguard
sync(ja:jb)%ccfmax=0.
sync(i0)%ccfmax=spk
enddo
! do i=ia,ib
! write(15,3015) 0.001*(i-1)*df3+32.0,sync(i)%ccfmax,sync(i)%xdt, &
! sync(i)%ipol,sync(i)%iflip,sync(i)%birdie
!3015 format(3f10.3,2i6,L5)
! enddo
return
end subroutine wb_sync

22
map65/mainwindow.cpp
View File

@ -1293,7 +1293,25 @@ void MainWindow::decode() //decode()
datcom_.mousefqso=m_wide_graph_window->QSOfreq();
datcom_.ndepth=m_ndepth;
datcom_.ndiskdat=0;
if(m_diskData) datcom_.ndiskdat=1;
if(m_diskData) {
datcom_.ndiskdat=1;
int i0=m_path.indexOf(".tf2");
if(i0<0) i0=m_path.indexOf(".iq");
if(i0>0) {
// Compute self Doppler using the filename for Date and Time
int nyear=m_path.mid(i0-11,2).toInt()+2000;
int month=m_path.mid(i0-9,2).toInt();
int nday=m_path.mid(i0-7,2).toInt();
int nhr=m_path.mid(i0-4,2).toInt();
int nmin=m_path.mid(i0-2,2).toInt();
double uth=nhr + nmin/60.0;
int nfreq=(int)datcom_.fcenter;
int ndop00;
astrosub00_(&nyear, &month, &nday, &uth, &nfreq, m_myGrid.toLatin1(),&ndop00,6);
datcom_.nfast=ndop00; //Send self Doppler to decoder, via datcom
}
}
datcom_.neme=0;
if(ui->actionOnly_EME_calls->isChecked()) datcom_.neme=1;
@ -1322,7 +1340,7 @@ void MainWindow::decode() //decode()
datcom_.nxpol=0;
if(m_xpol) datcom_.nxpol=1;
datcom_.nmode=10*m_modeQ65 + m_modeJT65;
datcom_.nfast=1; //No longer used
// datcom_.nfast=1; //No longer used
datcom_.nsave=m_nsave;
datcom_.max_drift=ui->sbMaxDrift->value();

3
map65/mainwindow.h
View File

@ -322,6 +322,9 @@ extern "C" {
int len1, int len2);
int ptt_(int* nport, int* itx, int* iptt);
void astrosub00_ (int* nyear, int* month, int* nday, double* uth, int* nfreq,
const char* mygrid, int* ndop00, int len1);
}
#endif // MAINWINDOW_H

2
map65/plotter.cpp
View File

@ -776,7 +776,7 @@ void CPlotter::mouseMoveEvent (QMouseEvent * event)
if(lower) {
QToolTip::showText(event->globalPos(),QString::number(ndf));
} else {
QToolTip::showText(event->globalPos(),QString::number(freq));
QToolTip::showText(event->globalPos(),QString::number(freq,'f',3));
}
QWidget::mouseMoveEvent(event);
}

1
qmap/.gitignore vendored Normal file
View File

@ -0,0 +1 @@
~*

65
qmap/CMakeLists.txt Normal file
View File

@ -0,0 +1,65 @@
set (qmap_CXXSRCS
about.cpp
astro.cpp
devsetup.cpp
displaytext.cpp
getfile.cpp
main.cpp
mainwindow.cpp
meterwidget.cpp
plotter.cpp
signalmeter.cpp
soundin.cpp
widegraph.cpp
)
if (WIN32)
set (qmap_CXXSRCS ${qmap_CXXSRCS})
endif (WIN32)
set (qmap_UISRCS
about.ui
astro.ui
devsetup.ui
mainwindow.ui
widegraph.ui
)
set (qmap_C_and_CXXSRCS
${qmap_CSRCS}
${qmap_CXXSRCS}
)
set_property (SOURCE ${qmap_C_and_CXXSRCS} APPEND_STRING PROPERTY COMPILE_FLAGS " -include wsjtx_config.h")
set_property (SOURCE ${qmap_C_and_CXXSRCS} APPEND PROPERTY OBJECT_DEPENDS ${CMAKE_BINARY_DIR}/wsjtx_config.h)
# build the subdirectories
add_subdirectory (libqmap)
# UI generation
qt5_wrap_ui (qmap_GENUISRCS ${qmap_UISRCS})
add_executable (qmap ${qmap_CXXSRCS} ${qmap_CSRCS} ${qmap_GENUISRCS} qmap.rc)
target_include_directories (qmap PRIVATE ${CMAKE_SOURCE_DIR} ${FFTW3_INCLUDE_DIRS})
target_link_libraries (qmap wsjt_qt m65impl ${FFTW3_LIBRARIES} Qt5::Widgets Qt5::Network Usb::Usb)
if (WSJT_CREATE_WINMAIN)
set_target_properties (qmap PROPERTIES WIN32_EXECUTABLE ON)
endif (WSJT_CREATE_WINMAIN)
if (WIN32)
install (
CODE "get_filename_component (_path \"\$ENV{DESTDIR}\${CMAKE_INSTALL_PREFIX}/${CMAKE_INSTALL_BINDIR}/wsjtx_dir.txt\" REALPATH)
if (WIN32)
set (_separator \"\\\\\")
else ()
set (_separator \"/\")
endif ()
file (WRITE \"\${_path}\" \".\${_separator}\\n\")"
)
install (
TARGETS qmap
RUNTIME DESTINATION ${CMAKE_INSTALL_BINDIR} COMPONENT runtime
BUNDLE DESTINATION . COMPONENT runtime
)
endif ()

30
qmap/LICENSE_WHEATLEY.TXT Normal file
View File

@ -0,0 +1,30 @@
+ + + This Software is released under the "Simplified BSD License" + + +
Copyright 2010 Moe Wheatley. All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:
1. Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
2. Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in
the documentation and/or other materials provided with the
distribution.
THIS SOFTWARE IS PROVIDED BY Moe Wheatley ``AS IS'' AND ANY EXPRESS OR
IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL Moe Wheatley OR CONTRIBUTORS BE LIABLE
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
The views and conclusions contained in the software and documentation
are those of the authors and should not be interpreted as representing
official policies, either expressed or implied, of Moe Wheatley.

BIN
qmap/MAP65_Beta_Release.docx Normal file
View File

Binary file not shown.

23
qmap/about.cpp Normal file
View File

@ -0,0 +1,23 @@
#include "about.h"
#include "revision_utils.hpp"
#include "ui_about.h"
CAboutDlg::CAboutDlg(QWidget *parent) :
QDialog(parent),
ui(new Ui::CAboutDlg)
{
ui->setupUi(this);
ui->labelTxt->setText("<html><h2>" + QString {"QMAP v"
+ QCoreApplication::applicationVersion ()
+ " " + revision ()}.simplified () + "</h2><br />"
"QMAP is a wideband receiver for the Q65 protocol, intnded<br />"
"primarily for amateur radio EME communication. It works <br />"
"in close cooperation with WSJT-X, versions 2.7 and later. <br /><br />"
"Copyright 2001-2023 by Joe Taylor, K1JT. Additional <br />"
"acknowledgments are contained in the source code.");
}
CAboutDlg::~CAboutDlg()
{
delete ui;
}

23
qmap/about.h Normal file
View File

@ -0,0 +1,23 @@
#ifndef ABOUTDLG_H
#define ABOUTDLG_H
#include <QDialog>
namespace Ui {
class CAboutDlg;
}
class CAboutDlg : public QDialog
{
Q_OBJECT
public:
explicit CAboutDlg(QWidget *parent = nullptr);
~CAboutDlg();
private:
Ui::CAboutDlg *ui;
QString m_Str;
};
#endif // ABOUTDLG_H

37
qmap/about.ui Normal file
View File

@ -0,0 +1,37 @@
<?xml version="1.0" encoding="UTF-8"?>
<ui version="4.0">
<class>CAboutDlg</class>
<widget class="QDialog" name="CAboutDlg">
<property name="windowModality">
<enum>Qt::NonModal</enum>
</property>
<property name="geometry">
<rect>
<x>0</x>
<y>0</y>
<width>374</width>
<height>164</height>
</rect>
</property>
<property name="sizePolicy">
<sizepolicy hsizetype="Preferred" vsizetype="Preferred">
<horstretch>0</horstretch>
<verstretch>0</verstretch>
</sizepolicy>
</property>
<property name="windowTitle">
<string>About MAP65</string>
</property>
<layout class="QHBoxLayout" name="horizontalLayout">
<item>
<widget class="QLabel" name="labelTxt">
<property name="text">
<string/>
</property>
</widget>
</item>
</layout>
</widget>
<resources/>
<connections/>
</ui>

257
qmap/afmhot.dat Normal file
View File

@ -0,0 +1,257 @@
0 0.0000 0.0000 0.0000
1 0.0000 0.0000 0.0000
2 0.0078 0.0000 0.0000
3 0.0157 0.0000 0.0000
4 0.0235 0.0000 0.0000
5 0.0314 0.0000 0.0000
6 0.0392 0.0000 0.0000
7 0.0471 0.0000 0.0000
8 0.0549 0.0000 0.0000
9 0.0627 0.0000 0.0000
10 0.0706 0.0000 0.0000
11 0.0784 0.0000 0.0000
12 0.0863 0.0000 0.0000
13 0.0941 0.0000 0.0000
14 0.1020 0.0000 0.0000
15 0.1098 0.0000 0.0000
16 0.1176 0.0000 0.0000
17 0.1255 0.0000 0.0000
18 0.1333 0.0000 0.0000
19 0.1412 0.0000 0.0000
20 0.1490 0.0000 0.0000
21 0.1569 0.0000 0.0000
22 0.1647 0.0000 0.0000
23 0.1725 0.0000 0.0000
24 0.1804 0.0000 0.0000
25 0.1882 0.0000 0.0000
26 0.1961 0.0000 0.0000
27 0.2039 0.0000 0.0000
28 0.2118 0.0000 0.0000
29 0.2196 0.0000 0.0000
30 0.2275 0.0000 0.0000
31 0.2353 0.0000 0.0000
32 0.2431 0.0000 0.0000
33 0.2510 0.0000 0.0000
34 0.2588 0.0000 0.0000
35 0.2667 0.0000 0.0000
36 0.2745 0.0000 0.0000
37 0.2824 0.0000 0.0000
38 0.2902 0.0000 0.0000
39 0.2980 0.0000 0.0000
40 0.3059 0.0000 0.0000
41 0.3137 0.0000 0.0000
42 0.3216 0.0000 0.0000
43 0.3294 0.0000 0.0000
44 0.3373 0.0000 0.0000
45 0.3451 0.0000 0.0000
46 0.3529 0.0000 0.0000
47 0.3608 0.0000 0.0000
48 0.3686 0.0000 0.0000
49 0.3765 0.0000 0.0000
50 0.3843 0.0000 0.0000
51 0.3922 0.0000 0.0000
52 0.4000 0.0000 0.0000
53 0.4078 0.0000 0.0000
54 0.4157 0.0000 0.0000
55 0.4235 0.0000 0.0000
56 0.4314 0.0000 0.0000
57 0.4392 0.0000 0.0000
58 0.4471 0.0000 0.0000
59 0.4549 0.0000 0.0000
60 0.4627 0.0000 0.0000
61 0.4706 0.0000 0.0000
62 0.4784 0.0000 0.0000
63 0.4863 0.0000 0.0000
64 0.4941 0.0000 0.0000
65 0.5020 0.0000 0.0000
66 0.5098 0.0098 0.0000
67 0.5176 0.0176 0.0000
68 0.5255 0.0255 0.0000
69 0.5333 0.0333 0.0000
70 0.5412 0.0412 0.0000
71 0.5490 0.0490 0.0000
72 0.5569 0.0569 0.0000
73 0.5647 0.0647 0.0000
74 0.5725 0.0725 0.0000
75 0.5804 0.0804 0.0000
76 0.5882 0.0882 0.0000
77 0.5961 0.0961 0.0000
78 0.6039 0.1039 0.0000
79 0.6118 0.1118 0.0000
80 0.6196 0.1196 0.0000
81 0.6275 0.1275 0.0000
82 0.6353 0.1353 0.0000
83 0.6431 0.1431 0.0000
84 0.6510 0.1510 0.0000
85 0.6588 0.1588 0.0000
86 0.6667 0.1667 0.0000
87 0.6745 0.1745 0.0000
88 0.6824 0.1824 0.0000
89 0.6902 0.1902 0.0000
90 0.6980 0.1980 0.0000
91 0.7059 0.2059 0.0000
92 0.7137 0.2137 0.0000
93 0.7216 0.2216 0.0000
94 0.7294 0.2294 0.0000
95 0.7373 0.2373 0.0000
96 0.7451 0.2451 0.0000
97 0.7529 0.2529 0.0000
98 0.7608 0.2608 0.0000
99 0.7686 0.2686 0.0000
100 0.7765 0.2765 0.0000
101 0.7843 0.2843 0.0000
102 0.7922 0.2922 0.0000
103 0.8000 0.3000 0.0000
104 0.8078 0.3078 0.0000
105 0.8157 0.3157 0.0000
106 0.8235 0.3235 0.0000
107 0.8314 0.3314 0.0000
108 0.8392 0.3392 0.0000
109 0.8471 0.3471 0.0000
110 0.8549 0.3549 0.0000
111 0.8627 0.3627 0.0000
112 0.8706 0.3706 0.0000
113 0.8784 0.3784 0.0000
114 0.8863 0.3863 0.0000
115 0.8941 0.3941 0.0000
116 0.9020 0.4020 0.0000
117 0.9098 0.4098 0.0000
118 0.9176 0.4176 0.0000
119 0.9255 0.4255 0.0000
120 0.9333 0.4333 0.0000
121 0.9412 0.4412 0.0000
122 0.9490 0.4490 0.0000
123 0.9569 0.4569 0.0000
124 0.9647 0.4647 0.0000
125 0.9725 0.4725 0.0000
126 0.9804 0.4804 0.0000
127 0.9882 0.4882 0.0000
128 0.9961 0.4961 0.0000
129 1.0000 0.5039 0.0000
130 1.0000 0.5118 0.0118
131 1.0000 0.5196 0.0196
132 1.0000 0.5275 0.0275
133 1.0000 0.5353 0.0353
134 1.0000 0.5431 0.0431
135 1.0000 0.5510 0.0510
136 1.0000 0.5588 0.0588
137 1.0000 0.5667 0.0667
138 1.0000 0.5745 0.0745
139 1.0000 0.5824 0.0824
140 1.0000 0.5902 0.0902
141 1.0000 0.5980 0.0980
142 1.0000 0.6059 0.1059
143 1.0000 0.6137 0.1137
144 1.0000 0.6216 0.1216
145 1.0000 0.6294 0.1294
146 1.0000 0.6373 0.1373
147 1.0000 0.6451 0.1451
148 1.0000 0.6529 0.1529
149 1.0000 0.6608 0.1608
150 1.0000 0.6686 0.1686
151 1.0000 0.6765 0.1765
152 1.0000 0.6843 0.1843
153 1.0000 0.6922 0.1922
154 1.0000 0.7000 0.2000
155 1.0000 0.7078 0.2078
156 1.0000 0.7157 0.2157
157 1.0000 0.7235 0.2235
158 1.0000 0.7314 0.2314
159 1.0000 0.7392 0.2392
160 1.0000 0.7471 0.2471
161 1.0000 0.7549 0.2549
162 1.0000 0.7627 0.2627
163 1.0000 0.7706 0.2706
164 1.0000 0.7784 0.2784
165 1.0000 0.7863 0.2863
166 1.0000 0.7941 0.2941
167 1.0000 0.8020 0.3020
168 1.0000 0.8098 0.3098
169 1.0000 0.8176 0.3176
170 1.0000 0.8255 0.3255
171 1.0000 0.8333 0.3333
172 1.0000 0.8412 0.3412
173 1.0000 0.8490 0.3490
174 1.0000 0.8569 0.3569
175 1.0000 0.8647 0.3647
176 1.0000 0.8725 0.3725
177 1.0000 0.8804 0.3804
178 1.0000 0.8882 0.3882
179 1.0000 0.8961 0.3961
180 1.0000 0.9039 0.4039
181 1.0000 0.9118 0.4118
182 1.0000 0.9196 0.4196
183 1.0000 0.9275 0.4275
184 1.0000 0.9353 0.4353
185 1.0000 0.9431 0.4431
186 1.0000 0.9510 0.4510
187 1.0000 0.9588 0.4588
188 1.0000 0.9667 0.4667
189 1.0000 0.9745 0.4745
190 1.0000 0.9824 0.4824
191 1.0000 0.9902 0.4902
192 1.0000 0.9980 0.4980
193 1.0000 1.0000 0.5059
194 1.0000 1.0000 0.5137
195 1.0000 1.0000 0.5216
196 1.0000 1.0000 0.5294
197 1.0000 1.0000 0.5373
198 1.0000 1.0000 0.5451
199 1.0000 1.0000 0.5529
200 1.0000 1.0000 0.5608
201 1.0000 1.0000 0.5686
202 1.0000 1.0000 0.5765
203 1.0000 1.0000 0.5843
204 1.0000 1.0000 0.5922
205 1.0000 1.0000 0.6000
206 1.0000 1.0000 0.6078
207 1.0000 1.0000 0.6157
208 1.0000 1.0000 0.6235
209 1.0000 1.0000 0.6314
210 1.0000 1.0000 0.6392
211 1.0000 1.0000 0.6471
212 1.0000 1.0000 0.6549
213 1.0000 1.0000 0.6627
214 1.0000 1.0000 0.6706
215 1.0000 1.0000 0.6784
216 1.0000 1.0000 0.6863
217 1.0000 1.0000 0.6941
218 1.0000 1.0000 0.7020
219 1.0000 1.0000 0.7098
220 1.0000 1.0000 0.7176
221 1.0000 1.0000 0.7255
222 1.0000 1.0000 0.7333
223 1.0000 1.0000 0.7412
224 1.0000 1.0000 0.7490
225 1.0000 1.0000 0.7569
226 1.0000 1.0000 0.7647
227 1.0000 1.0000 0.7725
228 1.0000 1.0000 0.7804
229 1.0000 1.0000 0.7882
230 1.0000 1.0000 0.7961
231 1.0000 1.0000 0.8039
232 1.0000 1.0000 0.8118
233 1.0000 1.0000 0.8196
234 1.0000 1.0000 0.8275
235 1.0000 1.0000 0.8353
236 1.0000 1.0000 0.8431
237 1.0000 1.0000 0.8510
238 1.0000 1.0000 0.8588
239 1.0000 1.0000 0.8667
240 1.0000 1.0000 0.8745
241 1.0000 1.0000 0.8824
242 1.0000 1.0000 0.8902
243 1.0000 1.0000 0.8980
244 1.0000 1.0000 0.9059
245 1.0000 1.0000 0.9137
246 1.0000 1.0000 0.9216
247 1.0000 1.0000 0.9294
248 1.0000 1.0000 0.9373
249 1.0000 1.0000 0.9451
250 1.0000 1.0000 0.9529
251 1.0000 1.0000 0.9608
252 1.0000 1.0000 0.9686
253 1.0000 1.0000 0.9765
254 1.0 0.0 0.0
255 1.0 1.0 0.0
256 0.0 1.000 0.0

199
qmap/astro.cpp Normal file
View File

@ -0,0 +1,199 @@
#include "astro.h"
#include <QSettings>
#include "ui_astro.h"
#include <QDebug>
#include <QFile>
#include <QMessageBox>
#include <stdio.h>
#include "SettingsGroup.hpp"
#include "commons.h"
#include <math.h>
extern "C" {
void astrosub_ (int* nyear, int* month, int* nday, double* uth, int* nfreq,
const char* mygrid, const char* hisgrid, double* azsun,
double* elsun, double* azmoon, double* elmoon, double* azmoondx,
double* elmoondx, int* ntsky, int* ndop, int* ndop00,
double* ramoon, double* decmoon, double* dgrd, double* poloffset,
double* xnr, int len1, int len2);
}
Astro::Astro (QString const& settings_filename, QWidget *parent) :
QWidget(parent),
ui(new Ui::Astro),
m_settings_filename {settings_filename}
{
ui->setupUi (this);
setWindowTitle ("Astronomical Data");
setWindowFlags(Qt::Dialog | Qt::WindowCloseButtonHint | Qt::WindowMinimizeButtonHint);
QSettings settings {m_settings_filename, QSettings::IniFormat};
SettingsGroup g {&settings, "MainWindow"}; // MainWindow group for
// historical reasons
setGeometry (settings.value ("AstroGeom", QRect {71, 390, 227, 403}).toRect ());
ui->astroTextBrowser->setStyleSheet(
"QTextBrowser { background-color : cyan; color : black; }");
ui->astroTextBrowser->clear();
m_AzElDir0="";
}
Astro::~Astro()
{
QSettings settings {m_settings_filename, QSettings::IniFormat};
SettingsGroup g {&settings, "MainWindow"};
settings.setValue ("AstroGeom", geometry ());
delete ui;
}
void Astro::astroUpdate(QDateTime t, QString mygrid, QString hisgrid,
int fQSO, int nsetftx, int ntxFreq, QString azelDir, double xavg)
{
static int ntxFreq0=-99;
char cc[300];
double azsun,elsun,azmoon,elmoon,azmoondx,elmoondx;
double ramoon,decmoon,dgrd,poloffset,xnr;
int ntsky,ndop,ndop00;
QString date = t.date().toString("yyyy MMM dd");
QString utc = t.time().toString();
int nyear=t.date().year();
int month=t.date().month();
int nday=t.date().day();
int nhr=t.time().hour();
int nmin=t.time().minute();
double sec=t.time().second() + 0.001*t.time().msec();
int isec=sec;
double uth=nhr + nmin/60.0 + sec/3600.0;
int nfreq=(int)datcom_.fcenter;
// if(nfreq<10 or nfreq > 50000) nfreq=144;
astrosub_(&nyear, &month, &nday, &uth, &nfreq, mygrid.toLatin1(),
hisgrid.toLatin1(), &azsun, &elsun, &azmoon, &elmoon,
&azmoondx, &elmoondx, &ntsky, &ndop, &ndop00,&ramoon, &decmoon,
&dgrd, &poloffset, &xnr, 6, 6);
datcom_.ndop00=ndop00; //Send self Doppler to decoder, via datcom
sprintf(cc,
"Az: %6.1f\n"
"El: %6.1f\n"
"MyDop: %6d\n"
"DxAz: %6.1f\n"
"DxEl: %6.1f\n"
"DxDop: %6d\n"
"Dec: %6.1f\n"
"SunAz: %6.1f\n"
"SunEl: %6.1f\n"
"Tsky: %6d\n"
"MNR: %6.1f\n"
"Dgrd: %6.1f",
azmoon,elmoon,ndop00,azmoondx,elmoondx,ndop,decmoon,azsun,elsun,
ntsky,xnr,dgrd);
ui->astroTextBrowser->setText(" "+ date + "\nUTC: " + utc + "\n" + cc);
double azOffset=0.0;
double elOffset=0.0;
double rad=57.2957795131;
int iCycle=2;
// Are we doing pointing tests?
bool bPointing=ui->cbPointingTests->isChecked();
ui->gbPointing->setVisible(bPointing);
if(bPointing) {
int nDwell=int(ui->sbDwell->value());
if(ui->cbAutoCycle->isChecked()) {
iCycle=(t.currentSecsSinceEpoch()%(6*nDwell))/nDwell + 1;
if(iCycle==1) {
azOffset = -ui->sbOffset->value()/cos(elsun/rad);
ui->rb1->setChecked(true);
}
if(iCycle==2 or iCycle==5) {
ui->rb2->setChecked(true);
}
if(iCycle==3) {
azOffset = +ui->sbOffset->value()/cos(elsun/rad);
ui->rb3->setChecked(true);
}
if(iCycle==4) {
elOffset = -ui->sbOffset->value();
ui->rb4->setChecked(true);
}
if(iCycle==6) {
elOffset = +ui->sbOffset->value();
ui->rb6->setChecked(true);
}
} else if(ui->cbOnOff->isChecked()) {
iCycle=(t.currentSecsSinceEpoch()%(2*nDwell))/nDwell + 1;
if(iCycle==1) {
azOffset = -ui->sbOffset->value()/cos(elsun/rad);
ui->rb1->setChecked(true);
}
if(iCycle==2) {
ui->rb2->setChecked(true);
}
} else {
if(ui->rb1->isChecked()) azOffset = -ui->sbOffset->value()/cos(elsun/rad);
if(ui->rb3->isChecked()) azOffset = ui->sbOffset->value()/cos(elsun/rad);
if(ui->rb4->isChecked()) elOffset = -ui->sbOffset->value();
if(ui->rb6->isChecked()) elOffset = ui->sbOffset->value();
}
if(ui->cbAutoCycle->isChecked() or ui->cbOnOff->isChecked()) {
QFile f("pointing.out");
if(f.open(QIODevice::WriteOnly | QIODevice::Append)) {
QTextStream out(&f);
out << t.toString("yyyy-MMM-dd hh:mm:ss");
sprintf(cc,"%7.1f %7.1f %d %7.1f %7.1f %10.1f %7.2f\n",
azsun,elsun,iCycle,azOffset,elOffset,xavg,10.0*log10(xavg));
out << cc;
f.close();
}
}
} else {
ui->rb2->setChecked(true);
ui->cbAutoCycle->setChecked(false);
ui->cbOnOff->setChecked(false);
}
// Write pointing data to azel.dat
QString fname=azelDir+"/azel.dat";
// qDebug() << "aa" << fname << isec << bPointing << azOffset << elOffset;
QFile f(fname);
if(!f.open(QIODevice::WriteOnly | QIODevice::Text)) {
if(azelDir==m_AzElDir0) return;
m_AzElDir0=azelDir;
QMessageBox mb;
mb.setText("Cannot open " + fname + "\nCorrect the setting of AzEl Directory in Setup?");
mb.exec();
return;
}
int ndiff=0;
if(ntxFreq != ntxFreq0) ndiff=1;
ntxFreq0=ntxFreq;
QTextStream out(&f);
sprintf(cc,"%2.2d:%2.2d:%2.2d,%5.1f,%5.1f,Moon\n"
"%2.2d:%2.2d:%2.2d,%5.1f,%5.1f,Sun\n"
"%2.2d:%2.2d:%2.2d,%5.1f,%5.1f,Source\n"
"%4d,%6d,%6d,Doppler\n"
"%3d,%1d,fQSO\n"
"%3d,%1d,fQSO2\n",
nhr,nmin,isec,azmoon,elmoon,
nhr,nmin,isec,azsun+azOffset,elsun+elOffset,
nhr,nmin,isec,0.0,0.0,
nfreq,ndop,ndop00,
fQSO,nsetftx,
ntxFreq,ndiff);
out << cc;
f.close();
}
void Astro::setFontSize(int n)
{
ui->astroTextBrowser->setFontPointSize(n);
}
void Astro::on_cbAutoCycle_clicked(bool checked)
{
if(checked) ui->cbOnOff->setChecked(false);
}
void Astro::on_cbOnOff_clicked(bool checked)
{
if(checked) ui->cbAutoCycle->setChecked(false);
}

32
qmap/astro.h Normal file
View File

@ -0,0 +1,32 @@
#ifndef ASTRO_H
#define ASTRO_H
#include <QWidget>
#include <QDateTime>
namespace Ui {
class Astro;
}
class Astro : public QWidget
{
Q_OBJECT
public:
explicit Astro (QString const& settings_filename, QWidget *parent = 0);
void astroUpdate(QDateTime t, QString mygrid, QString hisgrid,
int fQSO, int nsetftx, int ntxFreq, QString azelDir, double xavg);
void setFontSize(int n);
~Astro ();
private slots:
void on_cbOnOff_clicked(bool checked);
void on_cbAutoCycle_clicked(bool checked);
private:
Ui::Astro *ui;
QString m_settings_filename;
QString m_AzElDir0;
};
#endif

249
qmap/astro.ui Normal file
View File

@ -0,0 +1,249 @@
<?xml version="1.0" encoding="UTF-8"?>
<ui version="4.0">
<class>Astro</class>
<widget class="QWidget" name="Astro">
<property name="geometry">
<rect>
<x>0</x>
<y>0</y>
<width>441</width>
<height>483</height>
</rect>
</property>
<property name="windowTitle">
<string>Form</string>
</property>
<widget class="QGroupBox" name="gbPointing">
<property name="geometry">
<rect>
<x>269</x>
<y>19</y>
<width>151</width>
<height>431</height>
</rect>
</property>
<property name="title">
<string/>
</property>
<widget class="QRadioButton" name="rb1">
<property name="geometry">
<rect>
<x>10</x>
<y>100</y>
<width>30</width>
<height>17</height>
</rect>
</property>
<property name="text">
<string>1</string>
</property>
</widget>
<widget class="QRadioButton" name="rb2">
<property name="geometry">
<rect>
<x>60</x>
<y>100</y>
<width>40</width>
<height>17</height>
</rect>
</property>
<property name="text">
<string>2, 5</string>
</property>
<property name="checked">
<bool>true</bool>
</property>
</widget>
<widget class="QRadioButton" name="rb3">
<property name="geometry">
<rect>
<x>110</x>
<y>100</y>
<width>30</width>
<height>17</height>
</rect>
</property>
<property name="text">
<string>3</string>
</property>
</widget>
<widget class="QRadioButton" name="rb4">
<property name="geometry">
<rect>
<x>60</x>
<y>150</y>
<width>30</width>
<height>17</height>
</rect>
</property>
<property name="text">
<string>4</string>
</property>
</widget>
<widget class="QRadioButton" name="rb6">
<property name="geometry">
<rect>
<x>60</x>
<y>50</y>
<width>30</width>
<height>17</height>
</rect>
</property>
<property name="text">
<string>6</string>
</property>
</widget>
<widget class="QDoubleSpinBox" name="sbOffset">
<property name="geometry">
<rect>
<x>10</x>
<y>230</y>
<width>130</width>
<height>22</height>
</rect>
</property>
<property name="alignment">
<set>Qt::AlignCenter</set>
</property>
<property name="prefix">
<string>Offset </string>
</property>
<property name="suffix">
<string> deg</string>
</property>
<property name="decimals">
<number>1</number>
</property>
<property name="minimum">
<double>0.500000000000000</double>
</property>
<property name="maximum">
<double>20.000000000000000</double>
</property>
<property name="singleStep">
<double>0.500000000000000</double>
</property>
<property name="value">
<double>2.500000000000000</double>
</property>
</widget>
<widget class="QCheckBox" name="cbAutoCycle">
<property name="geometry">
<rect>
<x>30</x>
<y>330</y>
<width>91</width>
<height>17</height>
</rect>
</property>
<property name="text">
<string>Auto Cycle</string>
</property>
</widget>
<widget class="QCheckBox" name="cbOnOff">
<property name="geometry">
<rect>
<x>30</x>
<y>380</y>
<width>70</width>
<height>17</height>
</rect>
</property>
<property name="text">
<string>On Off</string>
</property>
</widget>
<widget class="QSpinBox" name="sbDwell">
<property name="geometry">
<rect>
<x>10</x>
<y>280</y>
<width>130</width>
<height>22</height>
</rect>
</property>
<property name="alignment">
<set>Qt::AlignCenter</set>
</property>
<property name="suffix">
<string> s</string>
</property>
<property name="prefix">
<string>Dwell </string>
</property>
<property name="minimum">
<number>10</number>
</property>
<property name="maximum">
<number>300</number>
</property>
<property name="singleStep">
<number>10</number>
</property>
</widget>
</widget>
<widget class="QWidget" name="">
<property name="geometry">
<rect>
<x>0</x>
<y>10</y>
<width>258</width>
<height>471</height>
</rect>
</property>
<layout class="QVBoxLayout" name="verticalLayout">
<item>
<widget class="QTextBrowser" name="astroTextBrowser">
<property name="font">
<font>
<family>Courier New</family>
<pointsize>20</pointsize>
<weight>75</weight>
<bold>true</bold>
</font>
</property>
</widget>
</item>
<item>
<layout class="QHBoxLayout" name="horizontalLayout">
<item>
<spacer name="horizontalSpacer_2">
<property name="orientation">
<enum>Qt::Horizontal</enum>
</property>
<property name="sizeHint" stdset="0">
<size>
<width>40</width>
<height>20</height>
</size>
</property>
</spacer>
</item>
<item>
<widget class="QCheckBox" name="cbPointingTests">
<property name="text">
<string>Pointing Tests</string>
</property>
</widget>
</item>
<item>
<spacer name="horizontalSpacer">
<property name="orientation">
<enum>Qt::Horizontal</enum>
</property>
<property name="sizeHint" stdset="0">
<size>
<width>40</width>
<height>20</height>
</size>
</property>
</spacer>
</item>
</layout>
</item>
</layout>
</widget>
</widget>
<resources/>
<connections/>
</ui>

256
qmap/blue.dat Normal file
View File

@ -0,0 +1,256 @@
0 0.0000 0.0000 0.0000
1 0.0902 0.0902 0.2558
2 0.1176 0.1176 0.2694
3 0.1412 0.1412 0.2820
4 0.1569 0.1569 0.2938
5 0.1725 0.1725 0.3049
6 0.1843 0.1843 0.3154
7 0.1961 0.1961 0.3254
8 0.2039 0.2039 0.3349
9 0.2157 0.2157 0.3440
10 0.2235 0.2235 0.3528
11 0.2314 0.2314 0.3612
12 0.2392 0.2392 0.3693
13 0.2471 0.2471 0.3772
14 0.2549 0.2549 0.3848
15 0.2588 0.2588 0.3921
16 0.2667 0.2667 0.3992
17 0.2706 0.2706 0.4061
18 0.2784 0.2784 0.4129
19 0.2824 0.2824 0.4194
20 0.2902 0.2902 0.4258
21 0.2941 0.2941 0.4319
22 0.2980 0.2980 0.4380
23 0.3059 0.3059 0.4439
24 0.3098 0.3098 0.4496
25 0.3137 0.3137 0.4553
26 0.3176 0.3176 0.4608
27 0.3216 0.3216 0.4661
28 0.3294 0.3294 0.4714
29 0.3333 0.3333 0.4765
30 0.3373 0.3373 0.4815
31 0.3412 0.3412 0.4865
32 0.3451 0.3451 0.4913
33 0.3490 0.3490 0.4960
34 0.3529 0.3529 0.5006
35 0.3569 0.3569 0.5052
36 0.3608 0.3608 0.5096
37 0.3647 0.3647 0.5140
38 0.3686 0.3686 0.5183
39 0.3725 0.3725 0.5225
40 0.3765 0.3765 0.5266
41 0.3804 0.3804 0.5306
42 0.3843 0.3843 0.5346
43 0.3843 0.3843 0.5385
44 0.3882 0.3882 0.5423
45 0.3922 0.3922 0.5460
46 0.3961 0.3961 0.5497
47 0.4000 0.4000 0.5533
48 0.4039 0.4039 0.5569
49 0.4078 0.4078 0.5603
50 0.4118 0.4118 0.5638
51 0.4118 0.4118 0.5671
52 0.4157 0.4157 0.5704
53 0.4196 0.4196 0.5736
54 0.4235 0.4235 0.5768
55 0.4275 0.4275 0.5799
56 0.4314 0.4314 0.5829
57 0.4314 0.4314 0.5859
58 0.4353 0.4353 0.5889
59 0.4392 0.4392 0.5917
60 0.4431 0.4431 0.5946
61 0.4471 0.4471 0.5973
62 0.4471 0.4471 0.6001
63 0.4510 0.4510 0.6027
64 0.4549 0.4549 0.6053
65 0.4588 0.4588 0.6079
66 0.4627 0.4627 0.6104
67 0.4627 0.4627 0.6129
68 0.4667 0.4667 0.6153
69 0.4706 0.4706 0.6176
70 0.4745 0.4745 0.6199
71 0.4745 0.4745 0.6222
72 0.4784 0.4784 0.6244
73 0.4824 0.4824 0.6266
74 0.4863 0.4863 0.6287
75 0.4863 0.4863 0.6308
76 0.4902 0.4902 0.6328
77 0.4941 0.4941 0.6348
78 0.4980 0.4980 0.6367
79 0.5020 0.5020 0.6386
80 0.5020 0.5020 0.6404
81 0.5059 0.5059 0.6422
82 0.5098 0.5098 0.6440
83 0.5098 0.5098 0.6457
84 0.5137 0.5137 0.6474
85 0.5176 0.5176 0.6490
86 0.5216 0.5216 0.6506
87 0.5216 0.5216 0.6521
88 0.5255 0.5255 0.6536
89 0.5294 0.5294 0.6551
90 0.5333 0.5333 0.6565
91 0.5333 0.5333 0.6578
92 0.5373 0.5373 0.6591
93 0.5412 0.5412 0.6604
94 0.5451 0.5451 0.6617
95 0.5451 0.5451 0.6629
96 0.5490 0.5490 0.6640
97 0.5529 0.5529 0.6651
98 0.5569 0.5569 0.6662
99 0.5569 0.5569 0.6672
100 0.5608 0.5608 0.6682
101 0.5647 0.5647 0.6692
102 0.5647 0.5647 0.6701
103 0.5686 0.5686 0.6710
104 0.5725 0.5725 0.6718
105 0.5765 0.5765 0.6726
106 0.5765 0.5765 0.6733
107 0.5804 0.5804 0.6740
108 0.5843 0.5843 0.6747
109 0.5843 0.5843 0.6753
110 0.5882 0.5882 0.6759
111 0.5922 0.5922 0.6765
112 0.5961 0.5961 0.6770
113 0.5961 0.5961 0.6774
114 0.6000 0.6000 0.6779
115 0.6039 0.6039 0.6783
116 0.6039 0.6039 0.6786
117 0.6078 0.6078 0.6789
118 0.6118 0.6118 0.6792
119 0.6157 0.6157 0.6794
120 0.6157 0.6157 0.6796
121 0.6196 0.6196 0.6798
122 0.6235 0.6235 0.6799
123 0.6235 0.6235 0.6800
124 0.6275 0.6275 0.6800
125 0.6314 0.6314 0.6800
126 0.6353 0.6353 0.6799
127 0.6353 0.6353 0.6799
128 0.6392 0.6392 0.6797
129 0.6431 0.6431 0.6796
130 0.6431 0.6431 0.6794
131 0.6471 0.6471 0.6791
132 0.6510 0.6510 0.6789
133 0.6549 0.6549 0.6785
134 0.6549 0.6549 0.6782
135 0.6588 0.6588 0.6778
136 0.6627 0.6627 0.6773
137 0.6627 0.6627 0.6769
138 0.6667 0.6667 0.6763
139 0.6706 0.6706 0.6758
140 0.6745 0.6745 0.6752
141 0.6745 0.6745 0.6746
142 0.6784 0.6784 0.6739
143 0.6824 0.6824 0.6732
144 0.6824 0.6824 0.6724
145 0.6863 0.6863 0.6716
146 0.6902 0.6902 0.6708
147 0.6941 0.6941 0.6699
148 0.6941 0.6941 0.6690
149 0.6980 0.6980 0.6680
150 0.7020 0.7020 0.6670
151 0.7020 0.7020 0.6660
152 0.7059 0.7059 0.6649
153 0.7098 0.7098 0.6638
154 0.7098 0.7098 0.6626
155 0.7137 0.7137 0.6614
156 0.7176 0.7176 0.6601
157 0.7216 0.7216 0.6589
158 0.7216 0.7216 0.6575
159 0.7255 0.7255 0.6561
160 0.7294 0.7294 0.6547
161 0.7294 0.7294 0.6533
162 0.7333 0.7333 0.6518
163 0.7373 0.7373 0.6502
164 0.7412 0.7412 0.6486
165 0.7412 0.7412 0.6470
166 0.7451 0.7451 0.6453
167 0.7490 0.7490 0.6436
168 0.7490 0.7490 0.6418
169 0.7529 0.7529 0.6400
170 0.7569 0.7569 0.6382
171 0.7608 0.7608 0.6363
172 0.7608 0.7608 0.6343
173 0.7647 0.7647 0.6324
174 0.7686 0.7686 0.6303
175 0.7686 0.7686 0.6282
176 0.7725 0.7725 0.6261
177 0.7765 0.7765 0.6239
178 0.7804 0.7804 0.6217
179 0.7804 0.7804 0.6194
180 0.7843 0.7843 0.6171
181 0.7882 0.7882 0.6147
182 0.7882 0.7882 0.6123
183 0.7922 0.7922 0.6098
184 0.7961 0.7961 0.6073
185 0.8000 0.8000 0.6047
186 0.8000 0.8000 0.6021
187 0.8039 0.8039 0.5994
188 0.8078 0.8078 0.5967
189 0.8078 0.8078 0.5939
190 0.8118 0.8118 0.5911
191 0.8157 0.8157 0.5882
192 0.8196 0.8196 0.5853
193 0.8196 0.8196 0.5823
194 0.8235 0.8235 0.5792
195 0.8275 0.8275 0.5761
196 0.8275 0.8275 0.5729
197 0.8314 0.8314 0.5697
198 0.8353 0.8353 0.5664
199 0.8392 0.8392 0.5630
200 0.8392 0.8392 0.5596
201 0.8431 0.8431 0.5561
202 0.8471 0.8471 0.5525
203 0.8471 0.8471 0.5489
204 0.8510 0.8510 0.5452
205 0.8549 0.8549 0.5414
206 0.8588 0.8588 0.5376
207 0.8588 0.8588 0.5337
208 0.8627 0.8627 0.5297
209 0.8667 0.8667 0.5257
210 0.8667 0.8667 0.5215
211 0.8706 0.8706 0.5173
212 0.8745 0.8745 0.5130
213 0.8784 0.8784 0.5086
214 0.8784 0.8784 0.5042
215 0.8824 0.8824 0.4996
216 0.8863 0.8863 0.4950
217 0.8863 0.8863 0.4902
218 0.8902 0.8902 0.4854
219 0.8941 0.8941 0.4804
220 0.8980 0.8980 0.4754
221 0.8980 0.8980 0.4702
222 0.9020 0.9020 0.4649
223 0.9059 0.9059 0.4595
224 0.9098 0.9098 0.4540
225 0.9098 0.9098 0.4484
226 0.9137 0.9137 0.4426
227 0.9176 0.9176 0.4366
228 0.9176 0.9176 0.4306
229 0.9216 0.9216 0.4243
230 0.9255 0.9255 0.4179
231 0.9294 0.9294 0.4114
232 0.9294 0.9294 0.4046
233 0.9333 0.9333 0.3977
234 0.9373 0.9373 0.3905
235 0.9373 0.9373 0.3831
236 0.9412 0.9412 0.3754
237 0.9451 0.9451 0.3675
238 0.9490 0.9490 0.3594
239 0.9490 0.9490 0.3509
240 0.9529 0.9529 0.3420
241 0.9569 0.9569 0.3328
242 0.9608 0.9608 0.3232
243 0.9608 0.9608 0.3131
244 0.9647 0.9647 0.3024
245 0.9686 0.9686 0.2912
246 0.9686 0.9686 0.2792
247 0.9725 0.9725 0.2664
248 0.9765 0.9765 0.2526
249 0.9804 0.9804 0.2375
250 0.9804 0.9804 0.2208
251 0.9843 0.9843 0.2020
252 0.9882 0.9882 0.1800
253 1.0 0.0 0.0
254 1.0 1.0 0.0
255 0.0 1.000 0.0

97
qmap/commons.h Normal file
View File

@ -0,0 +1,97 @@
#ifndef COMMONS_H
#define COMMONS_H
#define NFFT 32768
extern "C" {
extern struct { //This is "common/datcom/..." in Fortran
float d4[2*5760000]; //Raw I/Q data from Linrad
float ss[322*NFFT]; //Half-symbol spectra at 0,45,90,135 deg pol
float savg[NFFT]; //Avg spectra at 0,45,90,135 deg pol
double fcenter; //Center freq from Linrad (MHz)
int nutc; //UTC as integer, HHMM
float fselected; //Selected frequency for nagain decodes
int mousedf; //User-selected DF
int mousefqso; //User-selected QSO freq (kHz)
int nagain; //1 ==> decode only at fQSO +/- Tol
int ndepth; //How much hinted decoding to do?
int ndiskdat; //1 ==> data read from *.iq file
int neme; //Hinted decoding tries only for EME calls
int newdat; //1 ==> new data, must do long FFT
int nfa; //Low decode limit (kHz)
int nfb; //High decode limit (kHz)
int nfcal; //Frequency correction, for calibration (Hz)
int nfshift; //Shift of displayed center freq (kHz)
int mcall3; //1 ==> CALL3.TXT has been modified
int ntimeout; //Max for timeouts in Messages and BandMap
int ntol; //+/- decoding range around fQSO (Hz)
int nxant; //1 ==> add 45 deg to measured pol angle
int junk_1;
int nfsample; //Input sample rate
int nxpol; //1 if using xpol antennas, 0 otherwise
int nmode; //nmode = 10*m_modeQ65 + m_modeJT65
int ndop00; //EME Self Doppler
int nsave; //Number of s3(64,63) spectra saved
int max_drift; //Maximum Q65 drift: units symbol_rate/TxT
int nhsym; //Number of available JT65 half-symbols
char mycall[12];
char mygrid[6];
char hiscall[12];
char hisgrid[6];
char datetime[20];
int junk1; //Used to test extent of copy to shared memory
int junk2;
} datcom_;
extern struct { //This is "common/datcom/..." in Fortran
float d4[2*5760000]; //Raw I/Q data from Linrad
float ss[322*NFFT]; //Half-symbol spectra at 0,45,90,135 deg pol
float savg[NFFT]; //Avg spectra at 0,45,90,135 deg pol
double fcenter; //Center freq from Linrad (MHz)
int nutc; //UTC as integer, HHMM
float fselected; //Selected frequency for nagain decodes
int mousedf; //User-selected DF
int mousefqso; //User-selected QSO freq (kHz)
int nagain; //1 ==> decode only at fQSO +/- Tol
int ndepth; //How much hinted decoding to do?
int ndiskdat; //1 ==> data read from *.iq file
int neme; //Hinted decoding tries only for EME calls
int newdat; //1 ==> new data, must do long FFT
int nfa; //Low decode limit (kHz)
int nfb; //High decode limit (kHz)
int nfcal; //Frequency correction, for calibration (Hz)
int nfshift; //Shift of displayed center freq (kHz)
int mcall3; //1 ==> CALL3.TXT has been modified
int ntimeout; //Max for timeouts in Messages and BandMap
int ntol; //+/- decoding range around fQSO (Hz)
int nxant; //1 ==> add 45 deg to measured pol angle
int junk_1;
int nfsample; //Input sample rate
int nxpol; //1 if using xpol antennas, 0 otherwise
int nmode; //nmode = 10*m_modeQ65 + m_modeJT65
int ndop00; //EME Self Doppler
int nsave; //Number of s3(64,63) spectra saved
int max_drift; //Maximum Q65 drift: units symbol_rate/TxT
int nhsym; //Number of available JT65 half-symbols
char mycall[12];
char mygrid[6];
char hiscall[12];
char hisgrid[6];
char datetime[20];
int junk1; //Used to test extent of copy to shared memory
int junk2;
} datcom2_;
extern struct {
int ndecodes; //These are flags for inter-process communication
int ncand; //between QMAP and WSJT-X
int nQDecoderDone; //1 for real-time decodes, 2 for data from disk
int nWDecoderBusy; //Set to 1 when WSJT-X decoder is busy
int nWTransmitting; //Set to 1 when WSJT-X is transmitting
char result[50][60]; //Staging area for QMAP decodes
} decodes_;
}
#endif // COMMONS_H

48
qmap/devsetup.cpp Normal file
View File

@ -0,0 +1,48 @@
#include "devsetup.h"
#include "mainwindow.h"
#include <QTextStream>
#include <QDebug>
#include <cstdio>
//----------------------------------------------------------- DevSetup()
DevSetup::DevSetup(QWidget *parent) : QDialog(parent)
{
ui.setupUi(this); //setup the dialog form
m_restartSoundIn=false;
}
DevSetup::~DevSetup()
{
}
void DevSetup::initDlg()
{
ui.myCallEntry->setText(m_myCall);
ui.myGridEntry->setText(m_myGrid);
ui.astroFont->setValue(m_astroFont);
ui.saveDirEntry->setText(m_saveDir);
ui.azelDirEntry->setText(m_azelDir);
ui.fCalSpinBox->setValue(m_fCal);
ui.faddEntry->setText(QString::number(m_fAdd,'f',3));
ui.sbPort->setValue(m_udpPort);
ui.sb_dB->setValue(m_dB);
}
//------------------------------------------------------- accept()
void DevSetup::accept()
{
// Called when OK button is clicked.
// Check to see whether SoundInThread must be restarted,
// and save user parameters.
m_myCall=ui.myCallEntry->text();
m_myGrid=ui.myGridEntry->text();
m_astroFont=ui.astroFont->value();
m_saveDir=ui.saveDirEntry->text();
m_azelDir=ui.azelDirEntry->text();
m_fCal=ui.fCalSpinBox->value();
m_fAdd=ui.faddEntry->text().toDouble();
m_udpPort=ui.sbPort->value();
m_dB=ui.sb_dB->value();
QDialog::accept();
}

45
qmap/devsetup.h Normal file
View File

@ -0,0 +1,45 @@
#ifndef DEVSETUP_H
#define DEVSETUP_H
#include <QDialog>
#include "ui_devsetup.h"
class DevSetup : public QDialog
{
Q_OBJECT
public:
DevSetup(QWidget *parent=0);
~DevSetup();
void initDlg();
qint32 m_idInt;
qint32 m_pttPort;
qint32 m_timeout;
qint32 m_dPhi;
qint32 m_fCal;
qint32 m_udpPort;
qint32 m_astroFont;
qint32 m_dB;
double m_fAdd;
double m_TxOffset;
bool m_network;
bool m_fs96000;
bool m_restartSoundIn;
QString m_myCall;
QString m_myGrid;
QString m_saveDir;
QString m_azelDir;
QString m_editorCommand;
public slots:
void accept();
private:
int r,g,b,r0,g0,b0,r1,g1,b1,r2,g2,b2,r3,g3,b3;
Ui::DialogSndCard ui;
};
#endif // DEVSETUP_H

444
qmap/devsetup.ui Normal file
View File

@ -0,0 +1,444 @@
<?xml version="1.0" encoding="UTF-8"?>
<ui version="4.0">
<class>DialogSndCard</class>
<widget class="QDialog" name="DialogSndCard">
<property name="geometry">
<rect>
<x>0</x>
<y>0</y>
<width>463</width>
<height>390</height>
</rect>
</property>
<property name="windowTitle">
<string>Settings</string>
</property>
<layout class="QVBoxLayout" name="verticalLayout_2">
<item>
<widget class="QTabWidget" name="ioTabWidget">
<property name="currentIndex">
<number>0</number>
</property>
<widget class="QWidget" name="tab">
<attribute name="title">
<string>Station</string>
</attribute>
<widget class="QWidget" name="layoutWidget">
<property name="geometry">
<rect>
<x>10</x>
<y>34</y>
<width>421</width>
<height>275</height>
</rect>
</property>
<layout class="QVBoxLayout" name="verticalLayout_6">
<item>
<layout class="QHBoxLayout" name="horizontalLayout_2">
<item>
<layout class="QVBoxLayout" name="verticalLayout">
<item>
<widget class="QLabel" name="label">
<property name="minimumSize">
<size>
<width>0</width>
<height>20</height>
</size>
</property>
<property name="text">
<string>My Call:</string>
</property>
</widget>
</item>
<item>
<widget class="QLabel" name="label_2">
<property name="minimumSize">
<size>
<width>0</width>
<height>20</height>
</size>
</property>
<property name="text">
<string>My Grid:</string>
</property>
</widget>
</item>
<item>
<widget class="QLabel" name="label_7">
<property name="text">
<string>Astro Font Size:</string>
</property>
</widget>
</item>
</layout>
</item>
<item>
<layout class="QVBoxLayout" name="verticalLayout_3">
<item>
<widget class="QLineEdit" name="myCallEntry">
<property name="maximumSize">
<size>
<width>60</width>
<height>16777215</height>
</size>
</property>
<property name="text">
<string>K1JT</string>
</property>
</widget>
</item>
<item>
<widget class="QLineEdit" name="myGridEntry">
<property name="maximumSize">
<size>
<width>60</width>
<height>16777215</height>
</size>
</property>
<property name="text">
<string>FN20qi</string>
</property>
</widget>
</item>
<item>
<widget class="QSpinBox" name="astroFont">
<property name="minimum">
<number>12</number>
</property>
<property name="maximum">
<number>32</number>
</property>
<property name="value">
<number>20</number>
</property>
</widget>
</item>
</layout>
</item>
<item>
<spacer name="horizontalSpacer_2">
<property name="orientation">
<enum>Qt::Horizontal</enum>
</property>
<property name="sizeType">
<enum>QSizePolicy::Fixed</enum>
</property>
<property name="sizeHint" stdset="0">
<size>
<width>40</width>
<height>20</height>
</size>
</property>
</spacer>
</item>
<item>
<layout class="QVBoxLayout" name="verticalLayout_4">
<item>
<widget class="QLabel" name="label_9">
<property name="minimumSize">
<size>
<width>0</width>
<height>20</height>
</size>
</property>
<property name="text">
<string>Fcal (Hz):</string>
</property>
</widget>
</item>
<item>
<widget class="QLabel" name="label_11">
<property name="minimumSize">
<size>
<width>0</width>
<height>20</height>
</size>
</property>
<property name="text">
<string>Fadd (MHz)</string>
</property>
</widget>
</item>
<item>
<spacer name="verticalSpacer">
<property name="orientation">
<enum>Qt::Vertical</enum>
</property>
<property name="sizeType">
<enum>QSizePolicy::Fixed</enum>
</property>
<property name="sizeHint" stdset="0">
<size>
<width>20</width>
<height>20</height>
</size>
</property>
</spacer>
</item>
</layout>
</item>
<item>
<layout class="QVBoxLayout" name="verticalLayout_5">
<item>
<widget class="QSpinBox" name="fCalSpinBox">
<property name="minimum">
<number>-20000</number>
</property>
<property name="maximum">
<number>20000</number>
</property>
</widget>
</item>
<item>
<widget class="QLineEdit" name="faddEntry">
<property name="text">
<string>0.0</string>
</property>
</widget>
</item>
<item>
<spacer name="verticalSpacer_3">
<property name="orientation">
<enum>Qt::Vertical</enum>
</property>
<property name="sizeType">
<enum>QSizePolicy::Fixed</enum>
</property>
<property name="sizeHint" stdset="0">
<size>
<width>20</width>
<height>20</height>
</size>
</property>
</spacer>
</item>
</layout>
</item>
</layout>
</item>
<item>
<layout class="QHBoxLayout" name="horizontalLayout_3">
<item>
<widget class="QLabel" name="label_10">
<property name="minimumSize">
<size>
<width>80</width>
<height>20</height>
</size>
</property>
<property name="text">
<string>Save Directory:</string>
</property>
</widget>
</item>
<item>
<widget class="QLineEdit" name="saveDirEntry">
<property name="text">
<string/>
</property>
</widget>
</item>
</layout>
</item>
<item>
<layout class="QHBoxLayout" name="horizontalLayout_4">
<item>
<widget class="QLabel" name="label_6">
<property name="minimumSize">
<size>
<width>80</width>
<height>20</height>
</size>
</property>
<property name="text">
<string>AzEl Directory:</string>
</property>
</widget>
</item>
<item>
<widget class="QLineEdit" name="azelDirEntry">
<property name="text">
<string/>
</property>
</widget>
</item>
</layout>
</item>
</layout>
</widget>
</widget>
<widget class="QWidget" name="tab_2">
<property name="enabled">
<bool>true</bool>
</property>
<attribute name="title">
<string>I/O Devices</string>
</attribute>
<widget class="QWidget" name="layoutWidget_2">
<property name="geometry">
<rect>
<x>0</x>
<y>10</y>
<width>361</width>
<height>291</height>
</rect>
</property>
<layout class="QVBoxLayout" name="verticalLayout_8">
<item>
<widget class="QGroupBox" name="groupBox_2">
<property name="title">
<string>Input from Linrad</string>
</property>
<widget class="QWidget" name="layoutWidget_3">
<property name="geometry">
<rect>
<x>13</x>
<y>14</y>
<width>341</width>
<height>211</height>
</rect>
</property>
<layout class="QVBoxLayout" name="verticalLayout_7">
<item>
<layout class="QHBoxLayout" name="horizontalLayout_8">
<item>
<widget class="QSpinBox" name="sb_dB">
<property name="enabled">
<bool>true</bool>
</property>
<property name="toolTip">
<string>&lt;html&gt;&lt;head/&gt;&lt;body&gt;&lt;p&gt;Adjust to scale digital I/Q data.&lt;/p&gt;&lt;/body&gt;&lt;/html&gt;</string>
</property>
<property name="suffix">
<string> dB</string>
</property>
<property name="prefix">
<string>Gain </string>
</property>
<property name="minimum">
<number>-50</number>
</property>
<property name="maximum">
<number>10</number>
</property>
<property name="singleStep">
<number>1</number>
</property>
</widget>
</item>
<item>
<spacer name="horizontalSpacer_11">
<property name="orientation">
<enum>Qt::Horizontal</enum>
</property>
<property name="sizeHint" stdset="0">
<size>
<width>40</width>
<height>20</height>
</size>
</property>
</spacer>
</item>
<item>
<widget class="QSpinBox" name="sbPort">
<property name="minimumSize">
<size>
<width>57</width>
<height>0</height>
</size>
</property>
<property name="minimum">
<number>20000</number>
</property>
<property name="maximum">
<number>51000</number>
</property>
<property name="value">
<number>50004</number>
</property>
</widget>
</item>
<item>
<widget class="QLabel" name="label_Port">
<property name="sizePolicy">
<sizepolicy hsizetype="Fixed" vsizetype="Fixed">
<horstretch>0</horstretch>
<verstretch>0</verstretch>
</sizepolicy>
</property>
<property name="minimumSize">
<size>
<width>26</width>
<height>0</height>
</size>
</property>
<property name="maximumSize">
<size>
<width>16777215</width>
<height>20</height>
</size>
</property>
<property name="text">
<string>Port</string>
</property>
</widget>
</item>
</layout>
</item>
</layout>
</widget>
</widget>
</item>
</layout>
</widget>
</widget>
</widget>
</item>
<item>
<widget class="QDialogButtonBox" name="buttonBox">
<property name="orientation">
<enum>Qt::Horizontal</enum>
</property>
<property name="standardButtons">
<set>QDialogButtonBox::Cancel|QDialogButtonBox::Ok</set>
</property>
</widget>
</item>
</layout>
</widget>
<resources/>
<connections>
<connection>
<sender>buttonBox</sender>
<signal>accepted()</signal>
<receiver>DialogSndCard</receiver>
<slot>accept()</slot>
<hints>
<hint type="sourcelabel">
<x>257</x>
<y>380</y>
</hint>
<hint type="destinationlabel">
<x>157</x>
<y>274</y>
</hint>
</hints>
</connection>
<connection>
<sender>buttonBox</sender>
<signal>rejected()</signal>
<receiver>DialogSndCard</receiver>
<slot>reject()</slot>
<hints>
<hint type="sourcelabel">
<x>325</x>
<y>380</y>
</hint>
<hint type="destinationlabel">
<x>286</x>
<y>274</y>
</hint>
</hints>
</connection>
</connections>
</ui>

15
qmap/displaytext.cpp Normal file
View File

@ -0,0 +1,15 @@
#include "displaytext.h"
#include <QDebug>
#include <QMouseEvent>
DisplayText::DisplayText(QWidget *parent) :
QTextBrowser(parent)
{
}
void DisplayText::mouseDoubleClickEvent(QMouseEvent *e)
{
bool ctrl = (e->modifiers() & 0x4000000);
emit(selectCallsign(ctrl));
QTextBrowser::mouseDoubleClickEvent(e);
}

22
qmap/displaytext.h Normal file
View File

@ -0,0 +1,22 @@
#ifndef DISPLAYTEXT_H
#define DISPLAYTEXT_H
#include <QTextBrowser>
class DisplayText : public QTextBrowser
{
Q_OBJECT
public:
explicit DisplayText(QWidget *parent = 0);
signals:
void selectCallsign(bool ctrl);
public slots:
protected:
void mouseDoubleClickEvent(QMouseEvent *e);
};
#endif // DISPLAYTEXT_H

69
qmap/ffft.f Normal file
View File

@ -0,0 +1,69 @@
subroutine ffft(d,npts,isign,ireal)
C Fourier transform of length npts=2**k, performed in place.
C Input data in array d, treated as complex if ireal=0, and as real if ireal=1.
C In either case the transform values are returned in array d, treated as
C complex. The DC term is d(1), and d(npts/2+1) is the term at the Nyquist
C frequency. The basic algorithm is the same as Norm Brenner's FOUR1, and
C uses radix-2 transforms.
C J. H. Taylor, Princeton University.
complex d(npts),t,w,wstep,tt,uu
data pi/3.14159265359/
C Shuffle the data to bit-reversed order.
imax=npts/(ireal+1)
irev=1
do 5 i=1,imax
if(i.ge.irev) go to 2
t=d(i)
d(i)=d(irev)
d(irev)=t
2 mmax=imax/2
3 if(irev.le.mmax) go to 5
irev=irev-mmax
mmax=mmax/2
if(mmax.ge.1) go to 3
5 irev=irev+mmax
C The radix-2 transform begins here.
api=isign*pi/2.
mmax=1
6 istep=2*mmax
wstep=cmplx(-2.*sin(api/mmax)**2,sin(2.*api/mmax))
w=1.
do 9 m=1,mmax
C This in the inner-most loop -- optimization here is important!
do 8 i=m,imax,istep
t=w*d(i+mmax)
d(i+mmax)=d(i)-t
8 d(i)=d(i)+t
9 w=w*(1.+wstep)
mmax=istep
if(mmax.lt.imax) go to 6
if(ireal.eq.0) return
C Now complete the last stage of a doubled-up real transform.
jmax=imax/2 + 1
wstep=cmplx(-2.*sin(isign*pi/npts)**2,sin(isign*pi/imax))
w=1.0
d(imax+1)=d(1)
do 10 j=1,jmax
uu=cmplx(real(d(j))+real(d(2+imax-j)),aimag(d(j)) -
+ aimag(d(2+imax-j)))
tt=w*cmplx(aimag(d(j))+aimag(d(2+imax-j)),-real(d(j)) +
+ real(d(2+imax-j)))
d(j)=uu+tt
d(2+imax-j)=conjg(uu-tt)
10 w=w*(1.+wstep)
return
end

1
qmap/ft2000_freq.sh Normal file
View File

@ -0,0 +1 @@
rigctl-wsjtx -m 129 -r COM1 -s 38400 -C data_bits=8 -C stop_bits=2 -C serial_handshake=Hardware f

106
qmap/getfile.cpp Normal file
View File

@ -0,0 +1,106 @@
#include "getfile.h"
#include <QDir>
#include <stdio.h>
#include <stdlib.h>
#include <math.h>
extern qint16 id[2*60*96000];
void getfile(QString fname, bool xpol, int dbDgrd)
{
int npts=2*56*96000;
if(xpol) npts=2*npts;
// Degrade S/N by dbDgrd dB -- for tests only!!
float dgrd=0.0;
if(dbDgrd<0) dgrd = 23.0*sqrt(pow(10.0,-0.1*(double)dbDgrd) - 1.0);
float fac=23.0/sqrt(dgrd*dgrd + 23.0*23.0);
memset(id,0,2*npts);
char name[80];
strcpy(name,fname.toLocal8Bit());
FILE* fp=fopen(name,"rb");
if(fp != NULL) {
auto n = fread(&datcom_.fcenter,sizeof(datcom_.fcenter),1,fp);
// qDebug() << "aa0" << sizeof(datcom_.fcenter) << n << datcom_.fcenter;
n = fread(id,2,npts,fp);
Q_UNUSED (n);
int j=0;
if(dbDgrd<0) {
for(int i=0; i<npts; i+=2) {
datcom_.d4[j++]=fac*((float)id[i] + dgrd*gran());
datcom_.d4[j++]=fac*((float)id[i+1] + dgrd*gran());
// if(!xpol) j+=2; //Skip over d4(3,x) and d4(4,x)
}
} else {
for(int i=0; i<npts; i+=2) {
datcom_.d4[j++]=(float)id[i];
datcom_.d4[j++]=(float)id[i+1];
// if(!xpol) j+=2; //Skip over d4(3,x) and d4(4,x)
}
}
fclose(fp);
datcom_.ndiskdat=1;
int nfreq=(int)datcom_.fcenter;
if(nfreq!=144 and nfreq != 432 and nfreq != 1296) datcom_.fcenter=1296.080;
int i0=fname.indexOf(".tf2");
if(i0<0) i0=fname.indexOf(".iq");
datcom_.nutc=0;
if(i0>0) {
datcom_.nutc=100*fname.mid(i0-4,2).toInt() + fname.mid(i0-2,2).toInt();
}
}
}
void savetf2(QString fname, bool xpol)
{
int npts=2*56*96000;
if(xpol) npts=2*npts;
qint16* buf=(qint16*)malloc(2*npts);
char name[80];
strcpy(name,fname.toLocal8Bit());
FILE* fp=fopen(name,"wb");
if(fp != NULL) {
fwrite(&datcom_.fcenter,sizeof(datcom_.fcenter),1,fp);
int j=0;
for(int i=0; i<npts; i+=2) {
buf[i]=(qint16)datcom_.d4[j++];
buf[i+1]=(qint16)datcom_.d4[j++];
// if(!xpol) j+=2; //Skip over d4(3,x) and d4(4,x)
}
fwrite(buf,2,npts,fp);
fclose(fp);
}
free(buf);
}
/* Generate gaussian random float with mean=0 and std_dev=1 */
float gran()
{
float fac,rsq,v1,v2;
static float gset;
static int iset;
if(iset){
/* Already got one */
iset = 0;
return gset;
}
/* Generate two evenly distributed numbers between -1 and +1
* that are inside the unit circle
*/
do {
v1 = 2.0 * (float)rand() / RAND_MAX - 1;
v2 = 2.0 * (float)rand() / RAND_MAX - 1;
rsq = v1*v1 + v2*v2;
} while(rsq >= 1.0 || rsq == 0.0);
fac = sqrt(-2.0*log(rsq)/rsq);
gset = v1*fac;
iset++;
return v2*fac;
}

12
qmap/getfile.h Normal file
View File

@ -0,0 +1,12 @@
#ifndef GETFILE_H
#define GETFILE_H
#include <QString>
#include <QFile>
#include <QDebug>
#include "commons.h"
void getfile(QString fname, bool xpol, int dbDgrd);
void savetf2(QString fname, bool xpol);
float gran();
#endif // GETFILE_H

16
qmap/getsvn.cmake Normal file
View File

@ -0,0 +1,16 @@
find_package (Subversion)
if (Subversion_FOUND AND EXISTS ${PROJECT_SOURCE_DIR}/.svn)
# the FindSubversion.cmake module is part of the standard distribution
include (FindSubversion)
# extract working copy information for SOURCE_DIR into MY_XXX variables
Subversion_WC_INFO (${SOURCE_DIR} MY)
# write a file with the SVNVERSION define
file (WRITE svnversion.h.txt "#define SVNVERSION ${MY_WC_REVISION}\n")
else (Subversion_FOUND AND EXISTS ${PROJECT_SOURCE_DIR}/.svn)
file (WRITE svnversion.h.txt "#define SVNVERSION local\n")
endif (Subversion_FOUND AND EXISTS ${PROJECT_SOURCE_DIR}/.svn)
# copy the file to the final header only if the version changes
# reduces needless rebuilds
execute_process (COMMAND ${CMAKE_COMMAND} -E copy_if_different
svnversion.h.txt svnversion.h)

16
qmap/in.dat Normal file
View File

@ -0,0 +1,16 @@
35 36 22 8 31 11 14 55 20 36 55 13 24 15 56 38 16 28 61 58
15 26 45 8 41 53 37 57 59 60 29 29 41 46 44 35 52 61 24 26
16 20 53 35 2 6 9 27 47 28 57 6 15 9 16 10 56 9 63 46
9 15 3
74 61 44 233 29 245 254 64 119 64 250 111 38 145 53 29 140 194 119 99
55 86 48 110 142 95 48 120 61 66 252 252 245 88 62 41 124 249 246 68
250 249 65 64 140 142 88 190 237 90 240 52 79 216 55 31 112 135 66 44
99 57 68
54 61 26 5 13 60 3 56 30 58 57 4 16 43 28 43 6 61 13 19
56 8 4 9 45 32 9 7 14 52 4 38 40 27 3 26 51 54 40 29
36 63 34 43 3 48 36 49 46 30 8 20 40 59 29 28 17 11 8 19
11 63 5
38 25 35 8 28 0 0 60 60 25 0 31 28 52 14 24 9 30 18 54
49 55 48 15 27 54 26 22 30 27 1 1 4 31 35 29 23 2 2 27
0 1 25 32 21 84 28 19 5 60 2 27 15 9 39 23 42 12 29 17
16 50 49

54
qmap/libqmap/CMakeLists.txt Normal file
View File

@ -0,0 +1,54 @@
set (libq65_FSRCS
# Modules come first:
# Non-module Fortran routines:
astro.f90
astro0.f90
astrosub.f90
dcoord.f90
decode0.f90
dot.f90
fchisq0.f90
filbig.f90
four2a.f90
ftninit.f90
ftnquit.f90
geocentric.f90
getcand2.f90
grid2deg.f90
indexx.f90
lorentzian.f90
moon2.f90
moondop.f90
q65b.f90
q65c.f90
q65_sync.f90
qmapa.f90
recvpkt.f90
sun.f90
symspec.f90
timf2.f90
tm2.f90
toxyz.f90
f77_wisdom.f
)
#set (libq65_CXXSRCS
# ipcomm.cpp
# )
set (libq65_C_and_CXXSRCS
${libq65_CSRCS}
${libq65_CXXSRCS}
)
set_property (SOURCE ${libq65_C_and_CXXSRCS} APPEND_STRING PROPERTY COMPILE_FLAGS " -include wsjtx_config.h")
set_property (SOURCE ${libq65_C_and_CXXSRCS} APPEND PROPERTY OBJECT_DEPENDS ${CMAKE_BINARY_DIR}/wsjtx_config.h)
#
# build our targets
#
add_library (m65impl STATIC ${libq65_FSRCS} ${libq65_CSRCS} ${libq65_CXXSRCS})
target_link_libraries (m65impl wsjt_fort wsjt_cxx Qt5::Core)

105
qmap/libqmap/astro.f90 Normal file
View File

@ -0,0 +1,105 @@
subroutine astro(nyear,month,nday,uth,nfreq,Mygrid,NStation,MoonDX, &
AzSun,ElSun,AzMoon0,ElMoon0,ntsky,doppler00,doppler,dbMoon,RAMoon, &
DecMoon,HA,Dgrd,sd,poloffset,xnr,day,lon,lat,LST)
! Computes astronomical quantities for display and tracking.
! NB: may want to smooth the Tsky map to 10 degrees or so.
character*6 MyGrid,HisGrid
real LST
real lat,lon
integer*2 nt144(180)
! common/echo/xdop(2),techo,AzMoon,ElMoon,mjd
real xdop(2)
data rad/57.2957795/
data nt144/ &
234, 246, 257, 267, 275, 280, 283, 286, 291, 298, &
305, 313, 322, 331, 341, 351, 361, 369, 376, 381, &
383, 382, 379, 374, 370, 366, 363, 361, 363, 368, &
376, 388, 401, 415, 428, 440, 453, 467, 487, 512, &
544, 579, 607, 618, 609, 588, 563, 539, 512, 482, &
450, 422, 398, 379, 363, 349, 334, 319, 302, 282, &
262, 242, 226, 213, 205, 200, 198, 197, 196, 197, &
200, 202, 204, 205, 204, 203, 202, 201, 203, 206, &
212, 218, 223, 227, 231, 236, 240, 243, 247, 257, &
276, 301, 324, 339, 346, 344, 339, 331, 323, 316, &
312, 310, 312, 317, 327, 341, 358, 375, 392, 407, &
422, 437, 451, 466, 480, 494, 511, 530, 552, 579, &
612, 653, 702, 768, 863,1008,1232,1557,1966,2385, &
2719,2924,3018,3038,2986,2836,2570,2213,1823,1461, &
1163, 939, 783, 677, 602, 543, 494, 452, 419, 392, &
373, 360, 353, 350, 350, 350, 350, 350, 350, 348, &
344, 337, 329, 319, 307, 295, 284, 276, 272, 272, &
273, 274, 274, 271, 266, 260, 252, 245, 238, 231/
save
call grid2deg(MyGrid,elon,lat)
lon=-elon
call sun(nyear,month,nday,uth,lon,lat,RASun,DecSun,LST,AzSun,ElSun,mjd,day)
freq=nfreq*1.e6
if(nfreq.eq.2) freq=1.8e6
if(nfreq.eq.4) freq=3.5e6
call moondop(nyear,month,nday,uth,lon,lat,RAMoon,DecMoon,LST,HA, &
AzMoon,ElMoon,vr,dist)
! Compute spatial polarization offset
xx=sin(lat/rad)*cos(ElMoon/rad) - cos(lat/rad)*cos(AzMoon/rad)*sin(ElMoon/rad)
yy=cos(lat/rad)*sin(AzMoon/rad)
if(NStation.eq.1) poloffset1=rad*atan2(yy,xx)
if(NStation.eq.2) poloffset2=rad*atan2(yy,xx)
techo=2.0 * dist/2.99792458e5 !Echo delay time
doppler=-freq*vr/2.99792458e5 !One-way Doppler
call coord(0.,0.,-1.570796,1.161639,RAMoon/rad,DecMoon/rad,el,eb)
longecl_half=nint(rad*el/2.0)
if(longecl_half.lt.1 .or. longecl_half.gt.180) longecl_half=180
t144=nt144(longecl_half)
tsky=(t144-2.7)*(144.0/nfreq)**2.6 + 2.7 !Tsky for obs freq
xdop(NStation)=doppler
if(NStation.eq.2) then
HisGrid=MyGrid
go to 900
endif
doppler00=2.0*xdop(1)
doppler=xdop(1)+xdop(2)
! if(mode.eq.3) doppler=2.0*xdop(1)
dBMoon=-40.0*log10(dist/356903.)
sd=16.23*370152.0/dist
! if(NStation.eq.1 .and. MoonDX.ne.0 .and.
! + (mode.eq.2 .or. mode.eq.5)) then
if(NStation.eq.1 .and. MoonDX.ne.0) then
poloffset=mod(poloffset2-poloffset1+720.0,180.0)
if(poloffset.gt.90.0) poloffset=poloffset-180.0
x1=abs(cos(2*poloffset/rad))
if(x1.lt.0.056234) x1=0.056234
xnr=-20.0*log10(x1)
if(HisGrid(1:1).lt.'A' .or. HisGrid(1:1).gt.'R') xnr=0
endif
tr=80.0 !Good preamp
tskymin=13.0*(408.0/nfreq)**2.6 !Cold sky temperature
tsysmin=tskymin+tr
tsys=tsky+tr
dgrd=-10.0*log10(tsys/tsysmin) + dbMoon
900 AzMoon0=Azmoon
ElMoon0=Elmoon
ntsky=nint(tsky)
! auxHA = 15.0*(LST-auxra) !HA in degrees
! pi=3.14159265
! pio2=0.5*pi
! call coord(pi,pio2-lat/rad,0.0,lat/rad,auxha*pi/180.0,
! + auxdec/rad,azaux,elaux)
! AzAux=azaux*rad
! ElAux=ElAux*rad
return
end subroutine astro

81
qmap/libqmap/astro0.f90 Normal file
View File

@ -0,0 +1,81 @@
subroutine astro0(nyear,month,nday,uth8,nfreq,mygrid,hisgrid, &
AzSun8,ElSun8,AzMoon8,ElMoon8,AzMoonB8,ElMoonB8,ntsky,ndop,ndop00, &
dbMoon8,RAMoon8,DecMoon8,HA8,Dgrd8,sd8,poloffset8,xnr8,dfdt,dfdt0, &
width1,width2,w501,w502,xlst8)
parameter (DEGS=57.2957795130823d0)
character*6 mygrid,hisgrid
real*8 AzSun8,ElSun8,AzMoon8,ElMoon8,AzMoonB8,ElMoonB8
real*8 dbMoon8,RAMoon8,DecMoon8,HA8,Dgrd8,xnr8,dfdt,dfdt0,dt
real*8 sd8,poloffset8,day8,width1,width2,w501,w502,xlst8
real*8 uth8
data uth8z/0.d0/
save
uth=uth8
call astro(nyear,month,nday,uth,nfreq,hisgrid,2,1, &
AzSun,ElSun,AzMoon,ElMoon,ntsky,doppler00,doppler, &
dbMoon,RAMoon,DecMoon,HA,Dgrd,sd,poloffset,xnr, &
day,xlon2,xlat2,xlst)
AzMoonB8=AzMoon
ElMoonB8=ElMoon
call astro(nyear,month,nday,uth,nfreq,mygrid,1,1, &
AzSun,ElSun,AzMoon,ElMoon,ntsky,doppler00,doppler, &
dbMoon,RAMoon,DecMoon,HA,Dgrd,sd,poloffset,xnr, &
day,xlon1,xlat1,xlst)
day8=day
xlst8=xlst
call tm2(day8,xlat1,xlon1,xl1,b1)
call tm2(day8,xlat2,xlon2,xl2,b2)
call tm2(day8+1.d0/1440.0,xlat1,xlon1,xl1a,b1a)
call tm2(day8+1.d0/1440.0,xlat2,xlon2,xl2a,b2a)
fghz=0.001*nfreq
dldt1=DEGS*(xl1a-xl1)
dbdt1=DEGS*(b1a-b1)
dldt2=DEGS*(xl2a-xl2)
dbdt2=DEGS*(b2a-b2)
rate1=2.0*sqrt(dldt1**2 + dbdt1**2)
width1=0.5*6741*fghz*rate1
rate2=sqrt((dldt1+dldt2)**2 + (dbdt1+dbdt2)**2)
width2=0.5*6741*fghz*rate2
fbend=0.7
a2=0.0045*log(fghz/fbend)/log(1.05)
if(fghz.lt.fbend) a2=0.0
f50=0.19 * (fghz/fbend)**a2
if(f50.gt.1.0) f50=1.0
w501=f50*width1
w502=f50*width2
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
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
return
end subroutine astro0

26
qmap/libqmap/astrosub.f90 Normal file
View File

@ -0,0 +1,26 @@
subroutine astrosub(nyear,month,nday,uth8,nfreq,mygrid,hisgrid, &
AzSun8,ElSun8,AzMoon8,ElMoon8,AzMoonB8,ElMoonB8,ntsky,ndop,ndop00, &
RAMoon8,DecMoon8,Dgrd8,poloffset8,xnr8)
implicit real*8 (a-h,o-z)
character*6 mygrid,hisgrid
call astro0(nyear,month,nday,uth8,nfreq,mygrid,hisgrid, &
AzSun8,ElSun8,AzMoon8,ElMoon8,AzMoonB8,ElMoonB8,ntsky,ndop,ndop00, &
dbMoon8,RAMoon8,DecMoon8,HA8,Dgrd8,sd8,poloffset8,xnr8,dfdt,dfdt0, &
width1,width2,w501,w502,xlst8)
return
end subroutine astrosub
subroutine astrosub00(nyear,month,nday,uth8,nfreq,mygrid,ndop00)
implicit real*8 (a-h,o-z)
character*6 mygrid
call astrosub(nyear,month,nday,uth8,nfreq,mygrid,mygrid, &
AzSun8,ElSun8,AzMoon8,ElMoon8,AzMoonB8,ElMoonB8,ntsky,ndop,ndop00, &
RAMoon8,DecMoon8,Dgrd8,poloffset8,xnr8)
return
end subroutine astrosub00

40
qmap/libqmap/dcoord.f90 Normal file
View File

@ -0,0 +1,40 @@
SUBROUTINE DCOORD(A0,B0,AP,BP,A1,B1,A2,B2)
implicit real*8 (a-h,o-z)
! Examples:
! 1. From ha,dec to az,el:
! call coord(pi,pio2-lat,0.,lat,ha,dec,az,el)
! 2. From az,el to ha,dec:
! call coord(pi,pio2-lat,0.,lat,az,el,ha,dec)
! 3. From ra,dec to l,b
! call coord(4.635594495,-0.504691042,3.355395488,0.478220215,
! ra,dec,l,b)
! 4. From l,b to ra,dec
! call coord(1.705981071d0,-1.050357016d0,2.146800277d0,
! 0.478220215d0,l,b,ra,dec)
! 5. From ecliptic latitude (eb) and longitude (el) to ra, dec:
! call coord(0.d0,0.d0,-pio2,pio2-23.443*pi/180,ra,dec,el,eb)
SB0=sin(B0)
CB0=cos(B0)
SBP=sin(BP)
CBP=cos(BP)
SB1=sin(B1)
CB1=cos(B1)
SB2=SBP*SB1 + CBP*CB1*cos(AP-A1)
CB2=SQRT(1.D0-SB2**2)
B2=atan(SB2/CB2)
SAA=sin(AP-A1)*CB1/CB2
CAA=(SB1-SB2*SBP)/(CB2*CBP)
CBB=SB0/CBP
SBB=sin(AP-A0)*CB0
SA2=SAA*CBB-CAA*SBB
CA2=CAA*CBB+SAA*SBB
TA2O2=0.0 !Shut up compiler warnings. -db
IF(CA2.LE.0.D0) TA2O2=(1.D0-CA2)/SA2
IF(CA2.GT.0.D0) TA2O2=SA2/(1.D0+CA2)
A2=2.D0*atan(TA2O2)
IF(A2.LT.0.D0) A2=A2+6.2831853071795864D0
RETURN
END SUBROUTINE DCOORD

52
qmap/libqmap/decode0.f90 Normal file
View File

@ -0,0 +1,52 @@
subroutine decode0(dd,ss,savg)
use timer_module, only: timer
parameter (NSMAX=60*96000)
real*4 dd(2,NSMAX),ss(322,NFFT),savg(NFFT)
real*8 fcenter
integer hist(0:32768)
character mycall*12,hiscall*12,mygrid*6,hisgrid*6,datetime*20
character mycall0*12,hiscall0*12,hisgrid0*6
character*60 result
common/decodes/ndecodes,ncand,nQDecoderDone,nWDecoderBusy, &
nWTransmitting,result(50)
common/npar/fcenter,nutc,fselected,mousedf,mousefqso,nagain, &
ndepth,ndiskdat,neme,newdat,nfa,nfb,nfcal,nfshift, &
mcall3,nkeep,ntol,nxant,nrxlog,nfsample,nxpol,nmode, &
ndop00,nsave,max_drift,nhsym,mycall,mygrid,hiscall,hisgrid,datetime
data neme0/-99/
save
nQDecoderDone=0
if(newdat.ne.0) then
nz=96000*nhsym/5.3833
hist=0
do i=1,nz
j1=min(abs(dd(1,i)),32768.0)
hist(j1)=hist(j1)+1
j2=min(abs(dd(2,i)),32768.0)
hist(j2)=hist(j2)+1
enddo
m=0
do i=0,32768
m=m+hist(i)
if(m.ge.2*nz) go to 10
enddo
10 rmsdd=1.5*i
endif
mycall0=mycall
hiscall0=hiscall
hisgrid0=hisgrid
neme0=neme
call timer('qmapa ',0)
call qmapa(dd,ss,savg,newdat,nutc,fcenter,ntol,nfa,nfb, &
mousedf,mousefqso,nagain,nfshift,max_drift, &
nfcal,mycall,hiscall,hisgrid,nfsample,nmode,ndepth, &
datetime,ndop00,fselected)
call timer('qmapa ',1)
return
end subroutine decode0

11
qmap/libqmap/dot.f90 Normal file
View File

@ -0,0 +1,11 @@
real*8 function dot(x,y)
real*8 x(3),y(3)
dot=0.d0
do i=1,3
dot=dot+x(i)*y(i)
enddo
return
end function dot

45
qmap/libqmap/f77_wisdom.f Normal file
View File

@ -0,0 +1,45 @@
subroutine write_char(c, iunit)
character c
integer iunit
write(iunit,1000) c
1000 format(a,$)
end
subroutine export_wisdom_to_file(iunit)
integer iunit
external write_char
c call dfftw_export_wisdom(write_char, iunit)
call sfftw_export_wisdom(write_char, iunit)
end
subroutine read_char(ic, iunit)
integer ic
integer iunit
character*256 buf
save buf
integer ibuf
data ibuf/257/
save ibuf
if (ibuf .lt. 257) then
ic = ichar(buf(ibuf:ibuf))
ibuf = ibuf + 1
return
endif
read(iunit,1000,end=10) buf
1000 format(a256)
ic = ichar(buf(1:1))
ibuf = 2
return
10 ic = -1
ibuf = 257
rewind iunit
return
end
subroutine import_wisdom_from_file(isuccess, iunit)
integer isuccess
integer iunit
external read_char
c call dfftw_import_wisdom(isuccess, read_char, iunit)
call sfftw_import_wisdom(isuccess, read_char, iunit)
end

23
qmap/libqmap/fchisq0.f90 Normal file
View File

@ -0,0 +1,23 @@
real function fchisq0(y,npts,a)
real y(npts),a(4)
! rewind 51
chisq = 0.
do i=1,npts
x=i
z=(x-a(3))/(0.5*a(4))
yfit=a(1)
if(abs(z).lt.3.0) then
d=1.0 + z*z
yfit=a(1) + a(2) * (1.0/d - 0.1)
endif
chisq=chisq + (y(i) - yfit)**2
! write(51,3001) i,y(i),yfit,y(i)-yfit
!3001 format(i5,3f10.4)
enddo
fchisq0=chisq
return
end function fchisq0

64
qmap/libqmap/fftw3.f Normal file
View File

@ -0,0 +1,64 @@
INTEGER FFTW_R2HC
PARAMETER (FFTW_R2HC=0)
INTEGER FFTW_HC2R
PARAMETER (FFTW_HC2R=1)
INTEGER FFTW_DHT
PARAMETER (FFTW_DHT=2)
INTEGER FFTW_REDFT00
PARAMETER (FFTW_REDFT00=3)
INTEGER FFTW_REDFT01
PARAMETER (FFTW_REDFT01=4)
INTEGER FFTW_REDFT10
PARAMETER (FFTW_REDFT10=5)
INTEGER FFTW_REDFT11
PARAMETER (FFTW_REDFT11=6)
INTEGER FFTW_RODFT00
PARAMETER (FFTW_RODFT00=7)
INTEGER FFTW_RODFT01
PARAMETER (FFTW_RODFT01=8)
INTEGER FFTW_RODFT10
PARAMETER (FFTW_RODFT10=9)
INTEGER FFTW_RODFT11
PARAMETER (FFTW_RODFT11=10)
INTEGER FFTW_FORWARD
PARAMETER (FFTW_FORWARD=-1)
INTEGER FFTW_BACKWARD
PARAMETER (FFTW_BACKWARD=+1)
INTEGER FFTW_MEASURE
PARAMETER (FFTW_MEASURE=0)
INTEGER FFTW_DESTROY_INPUT
PARAMETER (FFTW_DESTROY_INPUT=1)
INTEGER FFTW_UNALIGNED
PARAMETER (FFTW_UNALIGNED=2)
INTEGER FFTW_CONSERVE_MEMORY
PARAMETER (FFTW_CONSERVE_MEMORY=4)
INTEGER FFTW_EXHAUSTIVE
PARAMETER (FFTW_EXHAUSTIVE=8)
INTEGER FFTW_PRESERVE_INPUT
PARAMETER (FFTW_PRESERVE_INPUT=16)
INTEGER FFTW_PATIENT
PARAMETER (FFTW_PATIENT=32)
INTEGER FFTW_ESTIMATE
PARAMETER (FFTW_ESTIMATE=64)
INTEGER FFTW_ESTIMATE_PATIENT
PARAMETER (FFTW_ESTIMATE_PATIENT=128)
INTEGER FFTW_BELIEVE_PCOST
PARAMETER (FFTW_BELIEVE_PCOST=256)
INTEGER FFTW_DFT_R2HC_ICKY
PARAMETER (FFTW_DFT_R2HC_ICKY=512)
INTEGER FFTW_NONTHREADED_ICKY
PARAMETER (FFTW_NONTHREADED_ICKY=1024)
INTEGER FFTW_NO_BUFFERING
PARAMETER (FFTW_NO_BUFFERING=2048)
INTEGER FFTW_NO_INDIRECT_OP
PARAMETER (FFTW_NO_INDIRECT_OP=4096)
INTEGER FFTW_ALLOW_LARGE_GENERIC
PARAMETER (FFTW_ALLOW_LARGE_GENERIC=8192)
INTEGER FFTW_NO_RANK_SPLITS
PARAMETER (FFTW_NO_RANK_SPLITS=16384)
INTEGER FFTW_NO_VRANK_SPLITS
PARAMETER (FFTW_NO_VRANK_SPLITS=32768)
INTEGER FFTW_NO_VRECURSE
PARAMETER (FFTW_NO_VRECURSE=65536)
INTEGER FFTW_NO_SIMD
PARAMETER (FFTW_NO_SIMD=131072)

64
qmap/libqmap/fftw3.f90 Normal file
View File

@ -0,0 +1,64 @@
INTEGER FFTW_R2HC
PARAMETER (FFTW_R2HC=0)
INTEGER FFTW_HC2R
PARAMETER (FFTW_HC2R=1)
INTEGER FFTW_DHT
PARAMETER (FFTW_DHT=2)
INTEGER FFTW_REDFT00
PARAMETER (FFTW_REDFT00=3)
INTEGER FFTW_REDFT01
PARAMETER (FFTW_REDFT01=4)
INTEGER FFTW_REDFT10
PARAMETER (FFTW_REDFT10=5)
INTEGER FFTW_REDFT11
PARAMETER (FFTW_REDFT11=6)
INTEGER FFTW_RODFT00
PARAMETER (FFTW_RODFT00=7)
INTEGER FFTW_RODFT01
PARAMETER (FFTW_RODFT01=8)
INTEGER FFTW_RODFT10
PARAMETER (FFTW_RODFT10=9)
INTEGER FFTW_RODFT11
PARAMETER (FFTW_RODFT11=10)
INTEGER FFTW_FORWARD
PARAMETER (FFTW_FORWARD=-1)
INTEGER FFTW_BACKWARD
PARAMETER (FFTW_BACKWARD=+1)
INTEGER FFTW_MEASURE
PARAMETER (FFTW_MEASURE=0)
INTEGER FFTW_DESTROY_INPUT
PARAMETER (FFTW_DESTROY_INPUT=1)
INTEGER FFTW_UNALIGNED
PARAMETER (FFTW_UNALIGNED=2)
INTEGER FFTW_CONSERVE_MEMORY
PARAMETER (FFTW_CONSERVE_MEMORY=4)
INTEGER FFTW_EXHAUSTIVE
PARAMETER (FFTW_EXHAUSTIVE=8)
INTEGER FFTW_PRESERVE_INPUT
PARAMETER (FFTW_PRESERVE_INPUT=16)
INTEGER FFTW_PATIENT
PARAMETER (FFTW_PATIENT=32)
INTEGER FFTW_ESTIMATE
PARAMETER (FFTW_ESTIMATE=64)
INTEGER FFTW_ESTIMATE_PATIENT
PARAMETER (FFTW_ESTIMATE_PATIENT=128)
INTEGER FFTW_BELIEVE_PCOST
PARAMETER (FFTW_BELIEVE_PCOST=256)
INTEGER FFTW_DFT_R2HC_ICKY
PARAMETER (FFTW_DFT_R2HC_ICKY=512)
INTEGER FFTW_NONTHREADED_ICKY
PARAMETER (FFTW_NONTHREADED_ICKY=1024)
INTEGER FFTW_NO_BUFFERING
PARAMETER (FFTW_NO_BUFFERING=2048)
INTEGER FFTW_NO_INDIRECT_OP
PARAMETER (FFTW_NO_INDIRECT_OP=4096)
INTEGER FFTW_ALLOW_LARGE_GENERIC
PARAMETER (FFTW_ALLOW_LARGE_GENERIC=8192)
INTEGER FFTW_NO_RANK_SPLITS
PARAMETER (FFTW_NO_RANK_SPLITS=16384)
INTEGER FFTW_NO_VRANK_SPLITS
PARAMETER (FFTW_NO_VRANK_SPLITS=32768)
INTEGER FFTW_NO_VRECURSE
PARAMETER (FFTW_NO_VRECURSE=65536)
INTEGER FFTW_NO_SIMD
PARAMETER (FFTW_NO_SIMD=131072)

123
qmap/libqmap/filbig.f90 Normal file
View File

@ -0,0 +1,123 @@
subroutine filbig(dd,nmax,f0,newdat,nfsample,c4a,n4)
! Filter and downsample complex data stored in array dd(2,nmax).
! Output is downsampled from 96000 Hz to 1375.125 Hz.
use timer_module, only: timer
parameter (MAXFFT1=5376000,MAXFFT2=77175)
real*4 dd(2,nmax) !Input data
complex ca(MAXFFT1) !FFT of input
complex c4a(MAXFFT2) !Output data
real*8 df
real halfpulse(8) !Impulse response of filter (one sided)
complex cfilt(MAXFFT2) !Filter (complex; imag = 0)
real rfilt(MAXFFT2) !Filter (real)
integer*8 plan1,plan2,plan3,plan4,plan5
logical first
include 'fftw3.f'
common/cacb/ca
equivalence (rfilt,cfilt)
data first/.true./,npatience/1/
data halfpulse/114.97547150,36.57879257,-20.93789101, &
5.89886379,1.59355187,-2.49138308,0.60910773,-0.04248129/
save
if(nmax.lt.0) go to 900
nfft1=MAXFFT1
nfft2=MAXFFT2
if(nfsample.eq.95238) then
nfft1=5120000
nfft2=74088
endif
if(first) then
nflags=FFTW_ESTIMATE
if(npatience.eq.1) nflags=FFTW_ESTIMATE_PATIENT
if(npatience.eq.2) nflags=FFTW_MEASURE
if(npatience.eq.3) nflags=FFTW_PATIENT
if(npatience.eq.4) nflags=FFTW_EXHAUSTIVE
! Plan the FFTs just once
call timer('FFTplans ',0)
call sfftw_plan_dft_1d(plan1,nfft1,ca,ca,FFTW_BACKWARD,nflags)
call sfftw_plan_dft_1d(plan3,nfft2,c4a,c4a,FFTW_FORWARD,nflags)
call sfftw_plan_dft_1d(plan5,nfft2,cfilt,cfilt,FFTW_BACKWARD,nflags)
call timer('FFTplans ',1)
! Convert impulse response to filter function
do i=1,nfft2
cfilt(i)=0.
enddo
fac=0.00625/nfft1
cfilt(1)=fac*halfpulse(1)
do i=2,8
cfilt(i)=fac*halfpulse(i)
cfilt(nfft2+2-i)=fac*halfpulse(i)
enddo
call sfftw_execute(plan5)
base=cfilt(nfft2/2+1)
do i=1,nfft2
rfilt(i)=real(cfilt(i))-base
enddo
df=96000.d0/nfft1
if(nfsample.eq.95238) df=95238.1d0/nfft1
first=.false.
endif
! When new data comes along, we need to compute a new "big FFT"
! If we just have a new f0, continue with the existing ca.
if(newdat.ne.0 .or. sum(abs(ca)).eq.0.0) then !### Test on ca should be unnecessary?
nz=min(nmax,nfft1)
do i=1,nz
ca(i)=cmplx(dd(1,i),dd(2,i))
enddo
if(nmax.lt.nfft1) then
do i=nmax+1,nfft1
ca(i)=0.
enddo
endif
call timer('FFTbig ',0)
call sfftw_execute(plan1)
call timer('FFTbig ',1)
!### newdat=0
endif
! NB: f0 is the frequency at which we want our filter centered.
! i0 is the bin number in ca closest to f0.
i0=nint(f0/df) + 1
nh=nfft2/2
do i=1,nh !Copy data into c4a
j=i0+i-1 !and apply the filter function
if(j.ge.1 .and. j.le.nfft1) then
c4a(i)=rfilt(i)*ca(j)
else
c4a(i)=0.
endif
enddo
do i=nh+1,nfft2
j=i0+i-1-nfft2
if(j.lt.1) j=j+nfft1
c4a(i)=rfilt(i)*ca(j)
enddo
! Do the short reverse transform, to go back to time domain.
call timer('FFTsmall',0)
call sfftw_execute(plan3)
call timer('FFTsmall',1)
n4=min(nmax/64,nfft2)
go to 999
900 call sfftw_destroy_plan(plan1)
call sfftw_destroy_plan(plan2)
call sfftw_destroy_plan(plan3)
call sfftw_destroy_plan(plan4)
call sfftw_destroy_plan(plan5)
999 return
end subroutine filbig

115
qmap/libqmap/four2a.f90 Normal file
View File

@ -0,0 +1,115 @@
subroutine four2a(a,nfft,ndim,isign,iform)
! IFORM = 1, 0 or -1, as data is
! complex, real, or the first half of a complex array. Transform
! values are returned in array DATA. They are complex, real, or
! the first half of a complex array, as IFORM = 1, -1 or 0.
! The transform of a real array (IFORM = 0) dimensioned N(1) by N(2)
! by ... will be returned in the same array, now considered to
! be complex of dimensions N(1)/2+1 by N(2) by .... Note that if
! IFORM = 0 or -1, N(1) must be even, and enough room must be
! reserved. The missing values may be obtained by complex conjugation.
! The reverse transformation of a half complex array dimensioned
! N(1)/2+1 by N(2) by ..., is accomplished by setting IFORM
! to -1. In the N array, N(1) must be the true N(1), not N(1)/2+1.
! The transform will be real and returned to the input array.
! This version of four2a makes calls to the FFTW library to do the
! actual computations.
use fftw3
parameter (NPMAX=2100) !Max numberf of stored plans
parameter (NSMALL=16384) !Max size of "small" FFTs
complex a(nfft+1) !Array to be transformed
complex aa(NSMALL) !Local copy of "small" a()
integer nn(NPMAX),ns(NPMAX),nf(NPMAX) !Params of stored plans
integer*8 nl(NPMAX),nloc !More params of plans
integer*8 plan(NPMAX) !Pointers to stored plans
logical found_plan
data nplan/0/ !Number of stored plans
common/patience/npatience,nthreads !Patience and threads for FFTW plans
save plan,nplan,nn,ns,nf,nl
if(nfft.lt.0) go to 999
nloc=loc(a)
found_plan = .false.
!$omp critical(four2a_setup)
do i=1,nplan
if(nfft.eq.nn(i) .and. isign.eq.ns(i) .and. &
iform.eq.nf(i) .and. nloc.eq.nl(i)) then
found_plan = .true.
exit
end if
enddo
if(i.ge.NPMAX) stop 'Too many FFTW plans requested.'
if (.not. found_plan) then
nplan=nplan+1
i=nplan
nn(i)=nfft
ns(i)=isign
nf(i)=iform
nl(i)=nloc
! Planning: FFTW_ESTIMATE, FFTW_ESTIMATE_PATIENT, FFTW_MEASURE,
! FFTW_PATIENT, FFTW_EXHAUSTIVE
nflags=FFTW_ESTIMATE
if(npatience.eq.1) nflags=FFTW_ESTIMATE_PATIENT
if(npatience.eq.2) nflags=FFTW_MEASURE
if(npatience.eq.3) nflags=FFTW_PATIENT
if(npatience.eq.4) nflags=FFTW_EXHAUSTIVE
if(nfft.le.NSMALL) then
jz=nfft
if(iform.eq.0) jz=nfft/2
aa(1:jz)=a(1:jz)
endif
!$omp critical(fftw) ! serialize non thread-safe FFTW3 calls
if(isign.eq.-1 .and. iform.eq.1) then
call sfftw_plan_dft_1d(plan(i),nfft,a,a,FFTW_FORWARD,nflags)
else if(isign.eq.1 .and. iform.eq.1) then
call sfftw_plan_dft_1d(plan(i),nfft,a,a,FFTW_BACKWARD,nflags)
else if(isign.eq.-1 .and. iform.eq.0) then
call sfftw_plan_dft_r2c_1d(plan(i),nfft,a,a,nflags)
else if(isign.eq.1 .and. iform.eq.-1) then
call sfftw_plan_dft_c2r_1d(plan(i),nfft,a,a,nflags)
else
stop 'Unsupported request in four2a'
endif
!$omp end critical(fftw)
if(nfft.le.NSMALL) then
jz=nfft
if(iform.eq.0) jz=nfft/2
a(1:jz)=aa(1:jz)
endif
end if
!$omp end critical(four2a_setup)
call sfftw_execute(plan(i))
return
999 continue
!$omp critical(four2a)
do i=1,nplan
! The test is only to silence a compiler warning:
if(ndim.ne.-999) then
!$omp critical(fftw) ! serialize non thread-safe FFTW3 calls
call sfftw_destroy_plan(plan(i))
!$omp end critical(fftw)
end if
enddo
nplan=0
!$omp end critical(four2a)
return
end subroutine four2a

33
qmap/libqmap/ftninit.f90 Normal file
View File

@ -0,0 +1,33 @@
subroutine ftninit
use timer_impl, only: init_timer !,fini_timer, limtrace
use, intrinsic :: iso_c_binding, only: C_NULL_CHAR
use FFTW3
! character*(*) appd
character*1 appd
character addpfx*8
character wisfile*256
common/pfxcom/addpfx
lu=8
call init_timer('./timer.out')
appd='.'
addpfx=' '
open(12,file=appd//'/all_qmap.txt',status='unknown',position='append')
open(17,file=appd//'/red.dat',status='unknown')
open(19,file=appd//'/livecq.txt',status='unknown')
open(71,file=appd//'/fort.71',status='unknown')
open(72,file=appd//'/fort.72',status='unknown')
open(73,file=appd//'/fort.73',status='unknown')
! Import FFTW wisdom, if available:
iret=fftwf_init_threads() !Initialize FFTW threading
! Default to 1 thread, but use nthreads for the big ones
call fftwf_plan_with_nthreads(1)
! Import FFTW wisdom, if available
wisfile=trim(appd)//'/m65_wisdom.dat'// C_NULL_CHAR
iret=fftwf_import_wisdom_from_filename(wisfile)
return
end subroutine ftninit

8
qmap/libqmap/ftnquit.f90 Normal file
View File

@ -0,0 +1,8 @@
subroutine ftnquit
! Destroy the FFTW plans
call four2a(a,-1,1,1,1)
call filbig(id,-1,f0,newdat,nfsample,c4a,n4)
return
end subroutine ftnquit

17
qmap/libqmap/geocentric.f90 Normal file
View File

@ -0,0 +1,17 @@
subroutine geocentric(alat,elev,hlt,erad)
implicit real*8 (a-h,o-z)
! IAU 1976 flattening f, equatorial radius a
f = 1.d0/298.257d0
a = 6378140.d0
c = 1.d0/sqrt(1.d0 + (-2.d0 + f)*f*sin(alat)*sin(alat))
arcf = (a*c + elev)*cos(alat)
arsf = (a*(1.d0 - f)*(1.d0 - f)*c + elev)*sin(alat)
hlt = datan2(arsf,arcf)
erad = sqrt(arcf*arcf + arsf*arsf)
erad = 0.001d0*erad
return
end subroutine geocentric

67
qmap/libqmap/getcand2.f90 Normal file
View File

@ -0,0 +1,67 @@
subroutine getcand2(ss,savg0,nts_q65,nagain,ntol,f0_selected,cand,ncand)
! Get candidates for Q65 decodes, based on presence of sync tone.
type candidate
real :: snr !Relative S/N of sync detection
real :: f !Freq of sync tone, 0 to 96000 Hz
real :: xdt !DT of matching sync pattern, -1.0 to +4.0 s
end type candidate
parameter (NFFT=32768) !FFTs done in symspec()
parameter (MAX_CANDIDATES=50)
type(candidate) :: cand(MAX_CANDIDATES)
real ss(322,NFFT) !Symbol spectra
real savg0(NFFT),savg(NFFT) !Average spectra over whole Rx sequence
integer ipk1(1) !Peak index of local portion of spectrum
logical sync_ok !True if sync pattern is present
data nseg/16/,npct/40/
savg=savg0 !Save the original spectrum
nlen=NFFT/nseg
do iseg=1,nseg !Normalize spectrum with nearby baseline
ja=(iseg-1)*nlen + 1
jb=ja + nlen - 1
call pctile(savg(ja),nlen,npct,base)
savg(ja:jb)=savg(ja:jb)/(1.015*base)
savg0(ja:jb)=savg0(ja:jb)/(1.015*base)
enddo
df=96000.0/NFFT
bw=65*nts_q65*1.666666667 !Bandwidth of Q65 signal
nbw=bw/df + 1 !Bandwidth in bins
nb0=2*nts_q65 !Range of peak search, in bins
smin=1.4 !First threshold
nguard=5 !Guard range in bins
i1=1
i2=NFFT-nbw-nguard
if(nagain.eq.1) then
i1=nint((1000.0*f0_selected-ntol)/df)
i2=nint((1000.0*f0_selected+ntol)/df)
endif
j=0
do i=i1,i2 !Look for local peaks in average spectrum
if(savg(i).lt.smin) cycle
spk=maxval(savg(i:i+nb0))
ipk1=maxloc(savg(i:i+nb0))
i0=ipk1(1) + i - 1 !Index of local peak in savg()
fpk=0.001*i0*df !Frequency of peak (kHz)
! Check to see if sync tone is present.
call q65_sync(ss,i0,nts_q65,sync_ok,snr_sync,xdt)
if(.not.sync_ok) cycle
! Sync tone is present, we have a candidate for decoding
j=j+1
cand(j)%f=fpk
cand(j)%xdt=xdt
cand(j)%snr=snr_sync
ia=max(1,min(i,i0-nguard))
ib=min(i0+nbw+nguard,32768)
savg(ia:ib)=0.
if(j.ge.MAX_CANDIDATES) exit
enddo
ncand=j !Total number of candidates found
return
end subroutine getcand2

18
qmap/libqmap/getdphi.f90 Normal file
View File

@ -0,0 +1,18 @@
subroutine getdphi(qphi)
real qphi(12)
s=0.
c=0.
do i=1,12
th=i*30/57.2957795
s=s+qphi(i)*sin(th)
c=c+qphi(i)*cos(th)
enddo
dphi=57.2957795*atan2(s,c)
write(*,1010) nint(dphi)
1010 format('!Best-fit Dphi =',i4,' deg')
return
end

38
qmap/libqmap/grid2deg.f90 Normal file
View File

@ -0,0 +1,38 @@
subroutine grid2deg(grid0,dlong,dlat)
! Converts Maidenhead grid locator to degrees of West longitude
! and North latitude.
character*6 grid0,grid
character*1 g1,g2,g3,g4,g5,g6
grid=grid0
i=ichar(grid(5:5))
if(grid(5:5).eq.' ' .or. i.le.64 .or. i.ge.128) grid(5:6)='mm'
if(grid(1:1).ge.'a' .and. grid(1:1).le.'z') grid(1:1)= &
char(ichar(grid(1:1))+ichar('A')-ichar('a'))
if(grid(2:2).ge.'a' .and. grid(2:2).le.'z') grid(2:2)= &
char(ichar(grid(2:2))+ichar('A')-ichar('a'))
if(grid(5:5).ge.'A' .and. grid(5:5).le.'Z') grid(5:5)= &
char(ichar(grid(5:5))-ichar('A')+ichar('a'))
if(grid(6:6).ge.'A' .and. grid(6:6).le.'Z') grid(6:6)= &
char(ichar(grid(6:6))-ichar('A')+ichar('a'))
g1=grid(1:1)
g2=grid(2:2)
g3=grid(3:3)
g4=grid(4:4)
g5=grid(5:5)
g6=grid(6:6)
nlong = 180 - 20*(ichar(g1)-ichar('A'))
n20d = 2*(ichar(g3)-ichar('0'))
xminlong = 5*(ichar(g5)-ichar('a')+0.5)
dlong = nlong - n20d - xminlong/60.0
nlat = -90+10*(ichar(g2)-ichar('A')) + ichar(g4)-ichar('0')
xminlat = 2.5*(ichar(g6)-ichar('a')+0.5)
dlat = nlat + xminlat/60.0
return
end subroutine grid2deg

91
qmap/libqmap/indexx.f90 Normal file
View File

@ -0,0 +1,91 @@
subroutine indexx(arr,n,indx)
parameter (M=7,NSTACK=50)
integer n,indx(n)
real arr(n)
integer i,indxt,ir,itemp,j,jstack,k,l,istack(NSTACK)
real a
do j=1,n
indx(j)=j
enddo
jstack=0
l=1
ir=n
1 if(ir-l.lt.M) then
do j=l+1,ir
indxt=indx(j)
a=arr(indxt)
do i=j-1,1,-1
if(arr(indx(i)).le.a) goto 2
indx(i+1)=indx(i)
enddo
i=0
2 indx(i+1)=indxt
enddo
if(jstack.eq.0) return
ir=istack(jstack)
l=istack(jstack-1)
jstack=jstack-2
else
k=(l+ir)/2
itemp=indx(k)
indx(k)=indx(l+1)
indx(l+1)=itemp
if(arr(indx(l+1)).gt.arr(indx(ir))) then
itemp=indx(l+1)
indx(l+1)=indx(ir)
indx(ir)=itemp
endif
if(arr(indx(l)).gt.arr(indx(ir))) then
itemp=indx(l)
indx(l)=indx(ir)
indx(ir)=itemp
endif
if(arr(indx(l+1)).gt.arr(indx(l))) then
itemp=indx(l+1)
indx(l+1)=indx(l)
indx(l)=itemp
endif
i=l+1
j=ir
indxt=indx(l)
a=arr(indxt)
3 continue
i=i+1
if(arr(indx(i)).lt.a) goto 3
4 continue
j=j-1
if(arr(indx(j)).gt.a) goto 4
if(j.lt.i) goto 5
itemp=indx(i)
indx(i)=indx(j)
indx(j)=itemp
goto 3
5 indx(l)=indx(j)
indx(j)=indxt
jstack=jstack+2
if(jstack.gt.NSTACK) stop 'NSTACK too small in indexx'
if(ir-i+1.ge.j-l)then
istack(jstack)=ir
istack(jstack-1)=i
ir=j-1
else
istack(jstack)=j-1
istack(jstack-1)=l
l=i
endif
endif
goto 1
end subroutine indexx

102
qmap/libqmap/lorentzian.f90 Normal file
View File

@ -0,0 +1,102 @@
subroutine lorentzian(y,npts,a)
! Input: y(npts); assume x(i)=i, i=1,npts
! Output: a(5)
! a(1) = baseline
! a(2) = amplitude
! a(3) = x0
! a(4) = width
! a(5) = chisqr
real y(npts)
real a(5)
real deltaa(4)
a=0.
df=12000.0/8192.0 !df = 1.465 Hz
width=0.
ipk=0
ymax=-1.e30
do i=1,npts
if(y(i).gt.ymax) then
ymax=y(i)
ipk=i
endif
! write(50,3001) i,i*df,y(i)
!3001 format(i6,2f12.3)
enddo
! base=(sum(y(ipk-149:ipk-50)) + sum(y(ipk+51:ipk+150)))/200.0
base=(sum(y(1:20)) + sum(y(npts-19:npts)))/40.0
stest=ymax - 0.5*(ymax-base)
ssum=y(ipk)
do i=1,50
if(ipk+i.gt.npts) exit
if(y(ipk+i).lt.stest) exit
ssum=ssum + y(ipk+i)
enddo
do i=1,50
if(ipk-i.lt.1) exit
if(y(ipk-i).lt.stest) exit
ssum=ssum + y(ipk-i)
enddo
ww=ssum/y(ipk)
width=2
t=ww*ww - 5.67
if(t.gt.0.0) width=sqrt(t)
a(1)=base
a(2)=ymax-base
a(3)=ipk
a(4)=width
! Now find Lorentzian parameters
deltaa(1)=0.1
deltaa(2)=0.1
deltaa(3)=1.0
deltaa(4)=1.0
nterms=4
! Start the iteration
chisqr=0.
chisqr0=1.e6
do iter=1,5
do j=1,nterms
chisq1=fchisq0(y,npts,a)
fn=0.
delta=deltaa(j)
10 a(j)=a(j)+delta
chisq2=fchisq0(y,npts,a)
if(chisq2.eq.chisq1) go to 10
if(chisq2.gt.chisq1) then
delta=-delta !Reverse direction
a(j)=a(j)+delta
tmp=chisq1
chisq1=chisq2
chisq2=tmp
endif
20 fn=fn+1.0
a(j)=a(j)+delta
chisq3=fchisq0(y,npts,a)
if(chisq3.lt.chisq2) then
chisq1=chisq2
chisq2=chisq3
go to 20
endif
! Find minimum of parabola defined by last three points
delta=delta*(1./(1.+(chisq1-chisq2)/(chisq3-chisq2))+0.5)
a(j)=a(j)-delta
deltaa(j)=deltaa(j)*fn/3.
! write(*,4000) iter,j,a,chisq2
!4000 format(i1,i2,4f10.4,f11.3)
enddo
chisqr=fchisq0(y,npts,a)
! write(*,4000) 0,0,a,chisqr
if(chisqr/chisqr0.gt.0.99) exit
chisqr0=chisqr
enddo
a(5)=chisqr
return
end subroutine lorentzian

163
qmap/libqmap/moon2.f90 Normal file
View File

@ -0,0 +1,163 @@
subroutine moon2(y,m,Day,UT,lon,lat,RA,Dec,topRA,topDec,LST,HA,Az,El,dist)
implicit none
integer y !Year
integer m !Month
integer Day !Day
real*8 UT !UTC in hours
real*8 RA,Dec !RA and Dec of moon
! NB: Double caps are single caps in the writeup.
real*8 NN !Longitude of ascending node
real*8 i !Inclination to the ecliptic
real*8 w !Argument of perigee
real*8 a !Semi-major axis
real*8 e !Eccentricity
real*8 MM !Mean anomaly
real*8 v !True anomaly
real*8 EE !Eccentric anomaly
real*8 ecl !Obliquity of the ecliptic
real*8 d !Ephemeris time argument in days
real*8 r !Distance to sun, AU
real*8 xv,yv !x and y coords in ecliptic
real*8 lonecl,latecl !Ecliptic long and lat of moon
real*8 xg,yg,zg !Ecliptic rectangular coords
real*8 Ms !Mean anomaly of sun
real*8 ws !Argument of perihelion of sun
real*8 Ls !Mean longitude of sun (Ns=0)
real*8 Lm !Mean longitude of moon
real*8 DD !Mean elongation of moon
real*8 FF !Argument of latitude for moon
real*8 xe,ye,ze !Equatorial geocentric coords of moon
real*8 mpar !Parallax of moon (r_E / d)
real*8 lat,lon !Station coordinates on earth
real*8 gclat !Geocentric latitude
real*8 rho !Earth radius factor
real*8 GMST0,LST,HA
real*8 g
real*8 topRA,topDec !Topocentric coordinates of Moon
real*8 Az,El
real*8 dist
real*8 rad,twopi,pi,pio2
data rad/57.2957795131d0/,twopi/6.283185307d0/
d=367*y - 7*(y+(m+9)/12)/4 + 275*m/9 + Day - 730530 + UT/24.d0
ecl = 23.4393d0 - 3.563d-7 * d
! Orbital elements for Moon:
NN = 125.1228d0 - 0.0529538083d0 * d
i = 5.1454d0
w = mod(318.0634d0 + 0.1643573223d0 * d + 360000.d0,360.d0)
a = 60.2666d0
e = 0.054900d0
MM = mod(115.3654d0 + 13.0649929509d0 * d + 360000.d0,360.d0)
EE = MM + e*rad*sin(MM/rad) * (1.d0 + e*cos(MM/rad))
EE = EE - (EE - e*rad*sin(EE/rad)-MM) / (1.d0 - e*cos(EE/rad))
EE = EE - (EE - e*rad*sin(EE/rad)-MM) / (1.d0 - e*cos(EE/rad))
xv = a * (cos(EE/rad) - e)
yv = a * (sqrt(1.d0-e*e) * sin(EE/rad))
v = mod(rad*atan2(yv,xv)+720.d0,360.d0)
r = sqrt(xv*xv + yv*yv)
! Get geocentric position in ecliptic rectangular coordinates:
xg = r * (cos(NN/rad)*cos((v+w)/rad)-sin(NN/rad)*sin((v+w)/rad)*cos(i/rad))
yg = r * (sin(NN/rad)*cos((v+w)/rad)+cos(NN/rad)*sin((v+w)/rad)*cos(i/rad))
zg = r * (sin((v+w)/rad)*sin(i/rad))
! Ecliptic longitude and latitude of moon:
lonecl = mod(rad*atan2(yg/rad,xg/rad)+720.d0,360.d0)
latecl = rad*atan2(zg/rad,sqrt(xg*xg + yg*yg)/rad)
! Now include orbital perturbations:
Ms = mod(356.0470d0 + 0.9856002585d0 * d + 3600000.d0,360.d0)
ws = 282.9404d0 + 4.70935d-5*d
Ls = mod(Ms + ws + 720.d0,360.d0)
Lm = mod(MM + w + NN+720.d0,360.d0)
DD = mod(Lm - Ls + 360.d0,360.d0)
FF = mod(Lm - NN + 360.d0,360.d0)
lonecl = lonecl &
- 1.274d0 * sin((MM-2.d0*DD)/rad) &
+ 0.658d0 * sin(2.d0*DD/rad) &
- 0.186d0 * sin(Ms/rad) &
- 0.059d0 * sin((2.d0*MM-2.d0*DD)/rad) &
- 0.057d0 * sin((MM-2.d0*DD+Ms)/rad) &
+ 0.053d0 * sin((MM+2.d0*DD)/rad) &
+ 0.046d0 * sin((2.d0*DD-Ms)/rad) &
+ 0.041d0 * sin((MM-Ms)/rad) &
- 0.035d0 * sin(DD/rad) &
- 0.031d0 * sin((MM+Ms)/rad) &
- 0.015d0 * sin((2.d0*FF-2.d0*DD)/rad) &
+ 0.011d0 * sin((MM-4.d0*DD)/rad)
latecl = latecl &
- 0.173d0 * sin((FF-2.d0*DD)/rad) &
- 0.055d0 * sin((MM-FF-2.d0*DD)/rad) &
- 0.046d0 * sin((MM+FF-2.d0*DD)/rad) &
+ 0.033d0 * sin((FF+2.d0*DD)/rad) &
+ 0.017d0 * sin((2.d0*MM+FF)/rad)
r = 60.36298d0 &
- 3.27746d0*cos(MM/rad) &
- 0.57994d0*cos((MM-2.d0*DD)/rad) &
- 0.46357d0*cos(2.d0*DD/rad) &
- 0.08904d0*cos(2.d0*MM/rad) &
+ 0.03865d0*cos((2.d0*MM-2.d0*DD)/rad) &
- 0.03237d0*cos((2.d0*DD-Ms)/rad) &
- 0.02688d0*cos((MM+2.d0*DD)/rad) &
- 0.02358d0*cos((MM-2.d0*DD+Ms)/rad) &
- 0.02030d0*cos((MM-Ms)/rad) &
+ 0.01719d0*cos(DD/rad) &
+ 0.01671d0*cos((MM+Ms)/rad)
dist=r*6378.140d0
! Geocentric coordinates:
! Rectangular ecliptic coordinates of the moon:
xg = r * cos(lonecl/rad)*cos(latecl/rad)
yg = r * sin(lonecl/rad)*cos(latecl/rad)
zg = r * sin(latecl/rad)
! Rectangular equatorial coordinates of the moon:
xe = xg
ye = yg*cos(ecl/rad) - zg*sin(ecl/rad)
ze = yg*sin(ecl/rad) + zg*cos(ecl/rad)
! Right Ascension, Declination:
RA = mod(rad*atan2(ye,xe)+360.d0,360.d0)
Dec = rad*atan2(ze,sqrt(xe*xe + ye*ye))
! Now convert to topocentric system:
mpar=rad*asin(1.d0/r)
! alt_topoc = alt_geoc - mpar*cos(alt_geoc)
gclat = lat - 0.1924d0*sin(2.d0*lat/rad)
rho = 0.99883d0 + 0.00167d0*cos(2.d0*lat/rad)
GMST0 = (Ls + 180.d0)/15.d0
LST = mod(GMST0+UT+lon/15.d0+48.d0,24.d0) !LST in hours
HA = 15.d0*LST - RA !HA in degrees
g = rad*atan(tan(gclat/rad)/cos(HA/rad))
topRA = RA - mpar*rho*cos(gclat/rad)*sin(HA/rad)/cos(Dec/rad)
topDec = Dec - mpar*rho*sin(gclat/rad)*sin((g-Dec)/rad)/sin(g/rad)
HA = 15.d0*LST - topRA !HA in degrees
if(HA.gt.180.d0) HA=HA-360.d0
if(HA.lt.-180.d0) HA=HA+360.d0
pi=0.5d0*twopi
pio2=0.5d0*pi
call dcoord(pi,pio2-lat/rad,0.d0,lat/rad,ha*twopi/360,topDec/rad,az,el)
Az=az*rad
El=El*rad
return
end subroutine moon2

72
qmap/libqmap/moondop.f90 Normal file
View File

@ -0,0 +1,72 @@
subroutine MoonDop(nyear,month,nday,uth4,lon4,lat4,RAMoon4,DecMoon4, &
LST4,HA4,AzMoon4,ElMoon4,vr4,dist4)
implicit real*8 (a-h,o-z)
real*4 uth4 !UT in hours
real*4 lon4 !West longitude, degrees
real*4 lat4 !Latitude, degrees
real*4 RAMoon4 !Topocentric RA of moon, hours
real*4 DecMoon4 !Topocentric Dec of Moon, degrees
real*4 LST4 !Locat sidereal time, hours
real*4 HA4 !Local Hour angle, degrees
real*4 AzMoon4 !Topocentric Azimuth of moon, degrees
real*4 ElMoon4 !Topocentric Elevation of moon, degrees
real*4 vr4 !Radial velocity of moon wrt obs, km/s
real*4 dist4 !Echo time, seconds
real*8 LST
real*8 RME(6) !Vector from Earth center to Moon
real*8 RAE(6) !Vector from Earth center to Obs
real*8 RMA(6) !Vector from Obs to Moon
real*8 rme0(6)
logical km
data rad/57.2957795130823d0/,twopi/6.28310530717959d0/
km=.true.
dlat=lat4/rad
dlong1=lon4/rad
elev1=200.d0
call geocentric(dlat,elev1,dlat1,erad1)
dt=100.d0 !For numerical derivative, in seconds
UT=uth4
! NB: geodetic latitude used here, but geocentric latitude used when
! determining Earth-rotation contribution to Doppler.
call moon2(nyear,month,nDay,UT-dt/3600.d0,dlong1*rad,dlat*rad, &
RA,Dec,topRA,topDec,LST,HA,Az0,El0,dist)
call toxyz(RA/rad,Dec/rad,dist,rme0) !Convert to rectangular coords
call moon2(nyear,month,nDay,UT,dlong1*rad,dlat*rad, &
RA,Dec,topRA,topDec,LST,HA,Az,El,dist)
call toxyz(RA/rad,Dec/rad,dist,rme) !Convert to rectangular coords
phi=LST*twopi/24.d0
call toxyz(phi,dlat1,erad1,rae) !Gencentric numbers used here!
radps=twopi/(86400.d0/1.002737909d0)
rae(4)=-rae(2)*radps !Vel of Obs wrt Earth center
rae(5)=rae(1)*radps
rae(6)=0.d0
do i=1,3
rme(i+3)=(rme(i)-rme0(i))/dt
rma(i)=rme(i)-rae(i)
rma(i+3)=rme(i+3)-rae(i+3)
enddo
call fromxyz(rma,alpha1,delta1,dtopo0) !Get topocentric coords
vr=dot(rma(4),rma)/dtopo0
RAMoon4=topRA
DecMoon4=topDec
LST4=LST
HA4=HA
AzMoon4=Az
ElMoon4=El
vr4=vr
dist4=dist
return
end subroutine MoonDop

60
qmap/libqmap/msgs.txt Normal file
View File

@ -0,0 +1,60 @@
W1AAA K2BBB EM00
W2CCC K3DDD EM01
W3EEE K4FFF EM02
W5GGG K6HHH EM03
W7III K8JJJ EM04
W9KKK K0LLL EM05
G0MMM F1NNN JN06
G2OOO F3PPP JN07
G4QQQ F5RRR JN08
G6SSS F7TTT JN09
W1XAA K2XBB EM10
W2XCC K3XDD EM11
W3XEE K4XFF EM12
W5XGG K6XHH EM13
W7XII K8XJJ EM14
W9XKK K0XLL EM15
G0XMM F1XNN JN16
G2XOO F3XPP JN17
G4XQQ F5XRR JN18
G6XSS F7XTT JN19
W1YAA K2YBB EM20
W2YCC K3YDD EM21
W3YEE K4YFF EM22
W5YGG K6YHH EM23
W7YII K8YJJ EM24
W9YKK K0YLL EM25
G0YMM F1YNN JN26
G2YOO F3YPP JN27
G4YQQ F5YRR JN28
G6YSS F7YTT JN29
W1ZAA K2ZBB EM30
W2ZCC K3ZDD EM31
W3ZEE K4ZFF EM32
W5ZGG K6ZHH EM33
W7ZII K8ZJJ EM34
W9ZKK K0ZLL EM35
G0ZMM F1ZNN JN36
G2ZOO F3ZPP JN37
G4ZQQ F5ZRR JN38
G6ZSS F7ZTT JN39
W1AXA K2BXB EM40
W2CXC K3DXD EM41
W3EXE K4FXF EM42
W5GXG K6HXH EM43
W7IXI K8JXJ EM44
W9KXK K0LXL EM45
G0MXM F1NXN JN46
G2OXO F3PXP JN47
G4QXQ F5RXR JN48
G6SXS F7TXT JN49
W1AYA K2BYB EM50
W2CYC K3DYD EM51
W3EYE K4FYF EM52
W5GYG K6HYH EM53
W7IYI K8JYJ EM54
W9KYK K0LYL EM55
G0MYM F1NYN JN56
G2OYO F3PYP JN57
G4QYQ F5RYR JN58
G6SYS F7TYT JN59

1
qmap/libqmap/njunk.f90 Normal file
View File

@ -0,0 +1 @@
parameter(NJUNK=40)

50
qmap/libqmap/pfx.f90 Normal file
View File

@ -0,0 +1,50 @@
parameter (NZ=339) !Total number of prefixes
parameter (NZ2=12) !Total number of suffixes
character*1 sfx(NZ2)
character*5 pfx(NZ)
data sfx/'P','0','1','2','3','4','5','6','7','8','9','A'/
data pfx/ &
'1A ','1S ','3A ','3B6 ','3B8 ','3B9 ','3C ','3C0 ', &
'3D2 ','3D2C ','3D2R ','3DA ','3V ','3W ','3X ','3Y ', &
'3YB ','3YP ','4J ','4L ','4S ','4U1I ','4U1U ','4W ', &
'4X ','5A ','5B ','5H ','5N ','5R ','5T ','5U ', &
'5V ','5W ','5X ','5Z ','6W ','6Y ','7O ','7P ', &
'7Q ','7X ','8P ','8Q ','8R ','9A ','9G ','9H ', &
'9J ','9K ','9L ','9M2 ','9M6 ','9N ','9Q ','9U ', &
'9V ','9X ','9Y ','A2 ','A3 ','A4 ','A5 ','A6 ', &
'A7 ','A9 ','AP ','BS7 ','BV ','BV9 ','BY ','C2 ', &
'C3 ','C5 ','C6 ','C9 ','CE ','CE0X ','CE0Y ','CE0Z ', &
'CE9 ','CM ','CN ','CP ','CT ','CT3 ','CU ','CX ', &
'CY0 ','CY9 ','D2 ','D4 ','D6 ','DL ','DU ','E3 ', &
'E4 ','EA ','EA6 ','EA8 ','EA9 ','EI ','EK ','EL ', &
'EP ','ER ','ES ','ET ','EU ','EX ','EY ','EZ ', &
'F ','FG ','FH ','FJ ','FK ','FKC ','FM ','FO ', &
'FOA ','FOC ','FOM ','FP ','FR ','FRG ','FRJ ','FRT ', &
'FT5W ','FT5X ','FT5Z ','FW ','FY ','M ','MD ','MI ', &
'MJ ','MM ', 'MU ','MW ','H4 ','H40 ','HA ', &
'HB ','HB0 ','HC ','HC8 ','HH ','HI ','HK ','HK0 ', &
'HK0M ','HL ','HM ','HP ','HR ','HS ','HV ','HZ ', &
'I ','IS ','IS0 ', 'J2 ','J3 ','J5 ','J6 ', &
'J7 ','J8 ','JA ','JDM ','JDO ','JT ','JW ', &
'JX ','JY ','K ','KG4 ','KH0 ','KH1 ','KH2 ','KH3 ', &
'KH4 ','KH5 ','KH5K ','KH6 ','KH7 ','KH8 ','KH9 ','KL ', &
'KP1 ','KP2 ','KP4 ','KP5 ','LA ','LU ','LX ','LY ', &
'LZ ','OA ','OD ','OE ','OH ','OH0 ','OJ0 ','OK ', &
'OM ','ON ','OX ','OY ','OZ ','P2 ','P4 ','PA ', &
'PJ2 ','PJ7 ','PY ','PY0F ','PT0S ','PY0T ','PZ ','R1F ', &
'R1M ','S0 ','S2 ','S5 ','S7 ','S9 ','SM ','SP ', &
'ST ','SU ','SV ','SVA ','SV5 ','SV9 ','T2 ','T30 ', &
'T31 ','T32 ','T33 ','T5 ','T7 ','T8 ','T9 ','TA ', &
'TF ','TG ','TI ','TI9 ','TJ ','TK ','TL ', &
'TN ','TR ','TT ','TU ','TY ','TZ ','UA ','UA2 ', &
'UA9 ','UK ','UN ','UR ','V2 ','V3 ','V4 ','V5 ', &
'V6 ','V7 ','V8 ','VE ','VK ','VK0H ','VK0M ','VK9C ', &
'VK9L ','VK9M ','VK9N ','VK9W ','VK9X ','VP2E ','VP2M ','VP2V ', &
'VP5 ','VP6 ','VP6D ','VP8 ','VP8G ','VP8H ','VP8O ','VP8S ', &
'VP9 ','VQ9 ','VR ','VU ','VU4 ','VU7 ','XE ','XF4 ', &
'XT ','XU ','XW ','XX9 ','XZ ','YA ','YB ','YI ', &
'YJ ','YK ','YL ','YN ','YO ','YS ','YU ','YV ', &
'YV0 ','Z2 ','Z3 ','ZA ','ZB ','ZC4 ','ZD7 ','ZD8 ', &
'ZD9 ','ZF ','ZK1N ','ZK1S ','ZK2 ','ZK3 ','ZL ','ZL7 ', &
'ZL8 ','ZL9 ','ZP ','ZS ','ZS8 ','KC4 ','E5 '/

60
qmap/libqmap/q65_sync.f90 Normal file
View File

@ -0,0 +1,60 @@
subroutine q65_sync(ss,i0,nts_q65,sync_ok,snr,xdt)
! Test for presence of Q65 sync tone
parameter (NFFT=32768)
parameter (LAGMAX=33)
real ss(322,NFFT) !Symbol spectra
real ccf(0:LAGMAX) !The WSJT "blue curve", peak at DT
logical sync_ok
logical first
integer isync(22),ipk(1)
! Q65 sync symbols
data isync/1,9,12,13,15,22,23,26,27,33,35,38,46,50,55,60,62,66,69,74,76,85/
data first/.true./
save first,isync
tstep=2048.0/11025.0 !0.185760 s: 0.5*tsym_jt65, 0.3096*tsym_q65
if(first) then
fac=0.6/tstep !3.230
do i=1,22 !Expand the Q65 sync stride
isync(i)=nint((isync(i)-1)*fac) + 1
enddo
first=.false.
endif
m=nts_q65/2
i1=max(1,i0-m)
i2=min(NFFT,i0+m)
ccf=0.
do lag=0,LAGMAX !Search over range of DT
do j=1,22 !Test for Q65 sync
k=isync(j) + lag
ccf(lag)=ccf(lag) + sum(ss(k,i1:i2)) + sum(ss(k+1,i1:i2)) &
+ sum(ss(k+2,i1:i2))
! Q: Should we use weighted sums, perhaps a Lorentzian peak?
enddo
enddo
ccfmax=maxval(ccf)
ipk=maxloc(ccf)
lagbest=ipk(1)-1
xdt=lagbest*tstep - 1.0
xsum=0.
sq=0.
nsum=0
do i=0,lagmax !Compute ave and rms of "blue curve"
if(abs(i-lagbest).gt.2) then
xsum=xsum+ccf(i)
sq=sq+ccf(i)**2
nsum=nsum+1
endif
enddo
ave=xsum/nsum
rms=sqrt(sq/nsum - ave*ave)
snr=(ccfmax-ave)/rms
sync_ok=snr.ge.5.0 !Require snr > 5.0 for sync detection
return
end subroutine q65_sync

125
qmap/libqmap/q65b.f90 Normal file
View File

@ -0,0 +1,125 @@
subroutine q65b(nutc,nqd,fcenter,nfcal,nfsample,ikhz,mousedf,ntol, &
mycall0,hiscall0,hisgrid,mode_q65,f0,fqso,nkhz_center, newdat,nagain, &
max_drift,ndepth,datetime,ndop00,idec)
! This routine provides an interface between QMAP and the Q65 decoder
! in WSJT-X. All arguments are input data obtained from the QMAP GUI.
! Raw Rx data are available as the 96 kHz complex spectrum ca(MAXFFT1)
! in common/cacb. Decoded messages are sent back to the GUI.
use q65_decode
use timer_module, only: timer
parameter (MAXFFT1=5376000) !56*96000
parameter (MAXFFT2=336000) !56*6000 (downsampled by 1/16)
parameter (NMAX=60*12000)
parameter (RAD=57.2957795)
integer*2 iwave(60*12000)
complex ca(MAXFFT1) !FFT of raw I/Q data from Linrad
complex cx(0:MAXFFT2-1),cz(0:MAXFFT2)
real*8 fcenter,freq0,freq1
character*12 mycall0,hiscall0
character*12 mycall,hiscall
character*6 hisgrid
character*4 grid4
character*60 result
character*20 datetime
common/decodes/ndecodes,ncand,nQDecoderDone,nWDecoderBusy, &
nWTransmitting,result(50)
common/cacb/ca
save
if(mycall0(1:1).ne.' ') mycall=mycall0
if(hiscall0(1:1).ne.' ') hiscall=hiscall0
if(hisgrid(1:4).ne.' ') grid4=hisgrid(1:4)
! Find best frequency from sync_dat, the "orange sync curve".
df3=96000.0/32768.0
ipk=(1000.0*f0-1.0)/df3
nfft1=MAXFFT1
nfft2=MAXFFT2
df=96000.0/NFFT1
if(nfsample.eq.95238) then
nfft1=5120000
nfft2=322560
df=96000.0/nfft1
endif
nh=nfft2/2
f_mouse=1000.0*(fqso+48.0) + mousedf
k0=nint((ipk*df3-1000.0)/df)
if(nagain.eq.1) k0=nint((f_mouse-1000.0)/df)
if(k0.lt.nh .or. k0.gt.MAXFFT1-nfft2+1) go to 900
fac=1.0/nfft2
cx(0:nfft2-1)=ca(k0:k0+nfft2-1)
cx=fac*cx
! Here cx is frequency-domain data around the selected
! QSO frequency, taken from the full-length FFT computed in filbig().
! Values for fsample, nfft1, nfft2, df, and the downsampled data rate
! are as follows:
! fSample nfft1 df nfft2 fDownSampled
! (Hz) (Hz) (Hz)
!----------------------------------------------------
! 96000 5376000 0.017857143 336000 6000.000
cz(0:MAXFFT2-1)=cx
cz(MAXFFT2)=0.
! Roll off below 500 Hz and above 2500 Hz.
ja=nint(500.0/df)
jb=nint(2500.0/df)
do i=0,ja
r=0.5*(1.0+cos(i*3.14159/ja))
cz(ja-i)=r*cz(ja-i)
cz(jb+i)=r*cz(jb+i)
enddo
cz(ja+jb+1:)=0.
!Transform to time domain (real), fsample=12000 Hz
call four2a(cz,2*nfft2,1,1,-1)
do i=0,nfft2-1
j=nfft2-1-i
iwave(2*i+2)=nint(real(cz(j))) !Note the reversed order!
iwave(2*i+1)=nint(aimag(cz(j)))
enddo
iwave(2*nfft2+1:)=0
nsubmode=mode_q65-1
nfa=990 !Tight limits around ipk for the wideband decode
nfb=1010
if(nagain.eq.1) then !For nagain=1, use limits of +/- ntol
nfa=max(100,1000-ntol)
nfb=min(2500,1000+ntol)
endif
nsnr0=-99 !Default snr for no decode
! NB: Frequency of ipk is now shifted to 1000 Hz.
call map65_mmdec(nutc,iwave,nqd,nsubmode,nfa,nfb,1000,ntol, &
newdat,nagain,max_drift,ndepth,mycall,hiscall,hisgrid)
MHz=fcenter
freq0=MHz + 0.001d0*ikhz
if(nsnr0.gt.-99) then
nq65df=nint(1000*(0.001*k0*df+nkhz_center-48.0+1.000-1.27046-ikhz))-nfcal
nq65df=nq65df + nfreq0 - 1000
ikhz1=ikhz
ndf=nq65df
if(ndf.gt.500) ikhz1=ikhz + (nq65df+500)/1000
if(ndf.lt.-500) ikhz1=ikhz + (nq65df-500)/1000
ndf=nq65df - 1000*(ikhz1-ikhz)
freq1=freq0 + 0.001d0*(ikhz1-ikhz)
ndecodes=ndecodes+1
frx=0.001*k0*df+nkhz_center-48.0+1.0 - 0.001*nfcal
fsked=frx - 0.001*ndop00/2.0 - 1.5
write(result(ndecodes),1120) nutc,frx,fsked,xdt0,nsnr0,trim(msg0)
1120 format(i4.4,f9.3,f7.1,f7.2,i5,2x,a)
write(12,1130) datetime,trim(result(ndecodes)(5:))
1130 format(a11,1x,a)
result(ndecodes)=trim(result(ndecodes))//char(0)
idec=0
endif
900 flush(12)
return
end subroutine q65b

51
qmap/libqmap/q65c.f90 Normal file
View File

@ -0,0 +1,51 @@
subroutine q65c(itimer)
use timer_module, only: timer
use timer_impl, only: fini_timer !, limtrace
use, intrinsic :: iso_c_binding, only: C_NULL_CHAR
use FFTW3
use q65
use q65_decode
parameter (NFFT=32768)
include 'njunk.f90'
real*8 fcenter
integer nparams0(NJUNK+3),nparams(NJUNK+3)
logical first
character*12 mycall,hiscall
character*6 mygrid,hisgrid
character*20 datetime
common/datcom2/dd(2,5760000),ss(322,NFFT),savg(NFFT),nparams0
!### REMEMBER that /npar/ is not updated until nparams=nparams0 is executed. ###
common/npar/fcenter,nutc,fselected,mousedf,mousefqso,nagain, &
ndepth,ndiskdat,neme,newdat,nfa,nfb,nfcal,nfshift, &
mcall3,nkeep,ntol,nxant,nrxlog,nfsample,nxpol,nmode, &
ndop00,nsave,max_drift,nhsym,mycall,mygrid,hiscall,hisgrid, &
datetime,junk1,junk2
equivalence (nparams,fcenter)
data first/.true./
save first
nparams=nparams0 !Copy parameters into common/npar/
if(itimer.ne.0) then
call timer('decode0 ',101)
call fini_timer
return
endif
datetime(18:20)=':00'
npatience=1
newdat=1 !Always on ??
! write(*,3001) 'aa',newdat,nagain,nfa,nfb,ntol,fselected
!3001 format(a2,5i6,f10.3)
! write(*,3001) 'bb',newdat,nagain,nfa,nfb,ntol,fselected
call timer('decode0 ',0)
call decode0(dd,ss,savg)
call timer('decode0 ',1)
return
end subroutine q65c

74
qmap/libqmap/qmapa.f90 Normal file
View File

@ -0,0 +1,74 @@
subroutine qmapa(dd,ss,savg,newdat,nutc,fcenter,ntol,nfa,nfb, &
mousedf,mousefqso,nagain,nfshift,max_drift,nfcal,mycall, &
hiscall,hisgrid,nfsample,nmode,ndepth,datetime,ndop00,fselected)
! Processes timf2 data received from Linrad to find and decode Q65 signals.
use timer_module, only: timer
type candidate
real :: snr !Relative S/N of sync detection
real :: f !Freq of sync tone, 0 to 96000 Hz
real :: xdt !DT of matching sync pattern, -1.0 to +4.0 s
end type candidate
parameter (NFFT=32768) !Size of FFTs done in symspec()
parameter (MAX_CANDIDATES=50)
parameter (MAXMSG=1000) !Size of decoded message list
parameter (NSMAX=60*96000)
complex cx(NSMAX/64) !Data at 1378.125 samples/s
real dd(2,NSMAX) !I/Q data from Linrad
real ss(322,NFFT) !Symbol spectra
real savg(NFFT) !Average spectrum
real*8 fcenter !Center RF frequency, MHz
character mycall*12,hiscall*12,hisgrid*6
type(candidate) :: cand(MAX_CANDIDATES)
character*60 result
character*20 datetime
common/decodes/ndecodes,ncand,nQDecoderDone,nWDecoderBusy, &
nWTransmitting,result(50)
save
tsec0=sec_midn()
if(nagain.eq.1) ndepth=3 !Use full depth for click-to-decode
nkhz_center=nint(1000.0*(fcenter-int(fcenter)))
mfa=nfa-nkhz_center+48
mfb=nfb-nkhz_center+48
mode_q65=nmode/10
nts_q65=2**(mode_q65-1) !Q65 tone separation factor
f0_selected=fselected - nkhz_center + 48.0
call timer('get_cand',0)
! Get a list of decoding candidates
call getcand2(ss,savg,nts_q65,nagain,ntol,f0_selected,cand,ncand)
call timer('get_cand',1)
nwrite_q65=0
df=96000.0/NFFT !df = 96000/NFFT = 2.930 Hz
if(nfsample.eq.95238) df=95238.1/NFFT
ftol=0.010 !Frequency tolerance (kHz)
foffset=0.001*(1270 + nfcal) !Offset from sync tone, plus CAL
fqso=mousefqso + foffset - 0.5*(nfa+nfb) + nfshift !fqso at baseband (khz)
nqd=0
nagain2=0
call timer('filbig ',0)
call filbig(dd,NSMAX,f0,newdat,nfsample,cx,n5) !Do the full-length FFT
call timer('filbig ',1)
do icand=1,ncand !Attempt to decode each candidate
f0=cand(icand)%f
freq=cand(icand)%f+nkhz_center-48.0-1.27046
ikhz=nint(freq)
idec=-1
call timer('q65b ',0)
call q65b(nutc,nqd,fcenter,nfcal,nfsample,ikhz,mousedf,ntol, &
mycall,hiscall,hisgrid,mode_q65,f0,fqso,nkhz_center,newdat, &
nagain2,max_drift,ndepth,datetime,ndop00,idec)
call timer('q65b ',1)
tsec=sec_midn() - tsec0
if(tsec.gt.30.0) exit !Don't start another decode attempt after t=30 s.
enddo ! icand
return
end subroutine qmapa

53
qmap/libqmap/recvpkt.f90 Normal file
View File

@ -0,0 +1,53 @@
subroutine recvpkt(nsam,nblock2,userx_no,k,buf4,buf8)
! Reformat timf2 data from Linrad and stuff data into r*4 array dd().
include 'njunk.f90'
parameter (NSMAX=60*96000) !Total sample intervals per minute
parameter (NFFT=32768)
integer*1 userx_no
real*4 d4,buf4(*) !(348)
real*8 d8,buf8(*) !(174)
integer*2 jd(4),kd(2),nblock2
real*4 yd(2)
real*8 fcenter
common/datcom/dd(2,5760000),ss(322,NFFT),savg(NFFT),fcenter,nutc, &
junk(NJUNK)
equivalence (kd,d4)
equivalence (jd,d8,yd)
if(nblock2.eq.-9999) nblock2=-9998 !Silence a compiler warning
if(nsam.eq.-1) then
! Move data from the UDP packet buffer into array dd().
if(userx_no.eq.-1) then
do i=1,174 !One RF channel, r*4 data
k=k+1
d8=buf8(i)
dd(1,k)=yd(1)
dd(2,k)=yd(2)
enddo
else if(userx_no.eq.1) then
do i=1,348 !One RF channel, i*2 data
k=k+1
d4=buf4(i)
dd(1,k)=kd(1)
dd(2,k)=kd(2)
enddo
endif
else
if(userx_no.eq.1) then
do i=1,nsam !One RF channel, r*4 data
k=k+1
d4=buf4(i)
dd(1,k)=kd(1)
dd(2,k)=kd(2)
k=k+1
dd(1,k)=kd(1)
dd(2,k)=kd(2)
enddo
endif
endif
return
end subroutine recvpkt

14
qmap/libqmap/rfile3a.f90 Normal file
View File

@ -0,0 +1,14 @@
subroutine rfile3a(infile,ibuf,n,fcenter,ierr)
character*(*) infile
integer*8 ibuf(n)
real*8 fcenter
open(10,file=infile,access='stream',status='old',err=998)
read(10,end=998) (ibuf(i),i=1,n/8),fcenter
ierr=0
go to 999
998 ierr=1002
999 close(10)
return
end subroutine rfile3a

31
qmap/libqmap/set.f90 Normal file
View File

@ -0,0 +1,31 @@
subroutine set(a,y,n)
real y(n)
do i=1,n
y(i)=a
enddo
return
end subroutine set
subroutine move(x,y,n)
real x(n),y(n)
do i=1,n
y(i)=x(i)
enddo
return
end subroutine move
subroutine zero(x,n)
real x(n)
do i=1,n
x(i)=0.0
enddo
return
end subroutine zero
subroutine add(a,b,c,n)
real a(n),b(n),c(n)
do i=1,n
c(i)=a(i)+b(i)
enddo
return
end subroutine add

27
qmap/libqmap/shell.f90 Normal file
View File

@ -0,0 +1,27 @@
subroutine shell(n,a)
integer n
real a(n)
integer i,j,inc
real v
inc=1
1 inc=3*inc+1
if(inc.le.n) go to 1
2 inc=inc/3
do i=inc+1,n
v=a(i)
j=i
3 if(a(j-inc).gt.v) then
a(j)=a(j-inc)
j=j-inc
if(j.le.inc) go to 4
go to 3
endif
4 a(j)=v
enddo
if(inc.gt.1) go to 2
return
end subroutine shell

4
qmap/libqmap/sleep_msec.f90 Normal file
View File

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

19
qmap/libqmap/smo.f90 Normal file
View File

@ -0,0 +1,19 @@
subroutine smo(x,npts,y,nadd)
real x(npts)
real y(npts)
nh=nadd/2
do i=1+nh,npts-nh
sum=0.
do j=-nh,nh
sum=sum + x(i+j)
enddo
y(i)=sum
enddo
x=y
x(:nh)=0.
x(npts-nh+1:)=0.
return
end subroutine smo

6
qmap/libqmap/sort.f90 Normal file
View File

@ -0,0 +1,6 @@
subroutine sort(n,arr)
call ssort(arr,tmp,n,1)
return
end subroutine sort

287
qmap/libqmap/ssort.f Normal file
View File

@ -0,0 +1,287 @@
subroutine ssort (x,y,n,kflag)
c***purpose sort an array and optionally make the same interchanges in
c an auxiliary array. the array may be sorted in increasing
c or decreasing order. a slightly modified quicksort
c algorithm is used.
c
c ssort sorts array x and optionally makes the same interchanges in
c array y. the array x may be sorted in increasing order or
c decreasing order. a slightly modified quicksort algorithm is used.
c
c description of parameters
c x - array of values to be sorted
c y - array to be (optionally) carried along
c n - number of values in array x to be sorted
c kflag - control parameter
c = 2 means sort x in increasing order and carry y along.
c = 1 means sort x in increasing order (ignoring y)
c = -1 means sort x in decreasing order (ignoring y)
c = -2 means sort x in decreasing order and carry y along.
integer kflag, n
! real x(n), y(n)
! real r, t, tt, tty, ty
integer x(n), y(n)
integer r, t, tt, tty, ty
integer i, ij, j, k, kk, l, m, nn
integer il(21), iu(21)
nn = n
if (nn .lt. 1) then
! print*,'ssort: The number of sort elements is not positive.'
! print*,'ssort: n = ',nn,' kflag = ',kflag
return
endif
c
kk = abs(kflag)
if (kk.ne.1 .and. kk.ne.2) then
print *,
+ 'the sort control parameter, k, is not 2, 1, -1, or -2.'
return
endif
c
c alter array x to get decreasing order if needed
c
if (kflag .le. -1) then
do 10 i=1,nn
x(i) = -x(i)
10 continue
endif
c
if (kk .eq. 2) go to 100
c
c sort x only
c
m = 1
i = 1
j = nn
r = 0.375e0
c
20 if (i .eq. j) go to 60
if (r .le. 0.5898437e0) then
r = r+3.90625e-2
else
r = r-0.21875e0
endif
c
30 k = i
c
c select a central element of the array and save it in location t
c
ij = i + int((j-i)*r)
t = x(ij)
c
c if first element of array is greater than t, interchange with t
c
if (x(i) .gt. t) then
x(ij) = x(i)
x(i) = t
t = x(ij)
endif
l = j
c
c if last element of array is less than than t, interchange with t
c
if (x(j) .lt. t) then
x(ij) = x(j)
x(j) = t
t = x(ij)
c
c if first element of array is greater than t, interchange with t
c
if (x(i) .gt. t) then
x(ij) = x(i)
x(i) = t
t = x(ij)
endif
endif
c
c find an element in the second half of the array which is smaller
c than t
c
40 l = l-1
if (x(l) .gt. t) go to 40
c
c find an element in the first half of the array which is greater
c than t
c
50 k = k+1
if (x(k) .lt. t) go to 50
c
c interchange these elements
c
if (k .le. l) then
tt = x(l)
x(l) = x(k)
x(k) = tt
go to 40
endif
c
c save upper and lower subscripts of the array yet to be sorted
c
if (l-i .gt. j-k) then
il(m) = i
iu(m) = l
i = k
m = m+1
else
il(m) = k
iu(m) = j
j = l
m = m+1
endif
go to 70
c
c begin again on another portion of the unsorted array
c
60 m = m-1
if (m .eq. 0) go to 190
i = il(m)
j = iu(m)
c
70 if (j-i .ge. 1) go to 30
if (i .eq. 1) go to 20
i = i-1
c
80 i = i+1
if (i .eq. j) go to 60
t = x(i+1)
if (x(i) .le. t) go to 80
k = i
c
90 x(k+1) = x(k)
k = k-1
if (t .lt. x(k)) go to 90
x(k+1) = t
go to 80
c
c sort x and carry y along
c
100 m = 1
i = 1
j = nn
r = 0.375e0
c
110 if (i .eq. j) go to 150
if (r .le. 0.5898437e0) then
r = r+3.90625e-2
else
r = r-0.21875e0
endif
c
120 k = i
c
c select a central element of the array and save it in location t
c
ij = i + int((j-i)*r)
t = x(ij)
ty = y(ij)
c
c if first element of array is greater than t, interchange with t
c
if (x(i) .gt. t) then
x(ij) = x(i)
x(i) = t
t = x(ij)
y(ij) = y(i)
y(i) = ty
ty = y(ij)
endif
l = j
c
c if last element of array is less than t, interchange with t
c
if (x(j) .lt. t) then
x(ij) = x(j)
x(j) = t
t = x(ij)
y(ij) = y(j)
y(j) = ty
ty = y(ij)
c
c if first element of array is greater than t, interchange with t
c
if (x(i) .gt. t) then
x(ij) = x(i)
x(i) = t
t = x(ij)
y(ij) = y(i)
y(i) = ty
ty = y(ij)
endif
endif
c
c find an element in the second half of the array which is smaller
c than t
c
130 l = l-1
if (x(l) .gt. t) go to 130
c
c find an element in the first half of the array which is greater
c than t
c
140 k = k+1
if (x(k) .lt. t) go to 140
c
c interchange these elements
c
if (k .le. l) then
tt = x(l)
x(l) = x(k)
x(k) = tt
tty = y(l)
y(l) = y(k)
y(k) = tty
go to 130
endif
c
c save upper and lower subscripts of the array yet to be sorted
c
if (l-i .gt. j-k) then
il(m) = i
iu(m) = l
i = k
m = m+1
else
il(m) = k
iu(m) = j
j = l
m = m+1
endif
go to 160
c
c begin again on another portion of the unsorted array
c
150 m = m-1
if (m .eq. 0) go to 190
i = il(m)
j = iu(m)
c
160 if (j-i .ge. 1) go to 120
if (i .eq. 1) go to 110
i = i-1
c
170 i = i+1
if (i .eq. j) go to 150
t = x(i+1)
ty = y(i+1)
if (x(i) .le. t) go to 170
k = i
c
180 x(k+1) = x(k)
y(k+1) = y(k)
k = k-1
if (t .lt. x(k)) go to 180
x(k+1) = t
y(k+1) = ty
go to 170
c
c clean up
c
190 if (kflag .le. -1) then
do 200 i=1,nn
x(i) = -x(i)
200 continue
endif
return
end

88
qmap/libqmap/sun.f90 Normal file
View File

@ -0,0 +1,88 @@
subroutine sun(y,m,DD,UT,lon,lat,RA,Dec,LST,Az,El,mjd,day)
implicit none
integer y !Year
integer m !Month
integer DD !Day
integer mjd !Modified Julian Date
real UT !UTC in hours
real RA,Dec !RA and Dec of sun
! NB: Double caps here are single caps in the writeup.
! Orbital elements of the Sun (also N=0, i=0, a=1):
real w !Argument of perihelion
real e !Eccentricity
real MM !Mean anomaly
real Ls !Mean longitude
! Other standard variables:
real v !True anomaly
real EE !Eccentric anomaly
real ecl !Obliquity of the ecliptic
real d !Ephemeris time argument in days
real r !Distance to sun, AU
real xv,yv !x and y coords in ecliptic
real lonsun !Ecliptic long and lat of sun
! Ecliptic coords of sun (geocentric)
real xs,ys
! Equatorial coords of sun (geocentric)
real xe,ye,ze
real lon,lat
real GMST0,LST,HA
real xx,yy,zz
real xhor,yhor,zhor
real Az,El
real day
real rad
data rad/57.2957795/
! Time in days, with Jan 0, 2000 equal to 0.0:
d=367*y - 7*(y+(m+9)/12)/4 + 275*m/9 + DD - 730530 + UT/24.0
mjd=d + 51543
ecl = 23.4393 - 3.563e-7 * d
! Compute updated orbital elements for Sun:
w = 282.9404 + 4.70935e-5 * d
e = 0.016709 - 1.151e-9 * d
MM = mod(356.0470d0 + 0.9856002585d0 * d + 360000.d0,360.d0)
Ls = mod(w+MM+720.0,360.0)
EE = MM + e*rad*sin(MM/rad) * (1.0 + e*cos(M/rad))
EE = EE - (EE - e*rad*sin(EE/rad)-MM) / (1.0 - e*cos(EE/rad))
xv = cos(EE/rad) - e
yv = sqrt(1.0-e*e) * sin(EE/rad)
v = rad*atan2(yv,xv)
r = sqrt(xv*xv + yv*yv)
lonsun = mod(v + w + 720.0,360.0)
! Ecliptic coordinates of sun (rectangular):
xs = r * cos(lonsun/rad)
ys = r * sin(lonsun/rad)
! Equatorial coordinates of sun (rectangular):
xe = xs
ye = ys * cos(ecl/rad)
ze = ys * sin(ecl/rad)
! RA and Dec in degrees:
RA = rad*atan2(ye,xe)
Dec = rad*atan2(ze,sqrt(xe*xe + ye*ye))
GMST0 = (Ls + 180.0)/15.0
LST = mod(GMST0+UT+lon/15.0+48.0,24.0) !LST in hours
HA = 15.0*LST - RA !HA in degrees
xx = cos(HA/rad)*cos(Dec/rad)
yy = sin(HA/rad)*cos(Dec/rad)
zz = sin(Dec/rad)
xhor = xx*sin(lat/rad) - zz*cos(lat/rad)
yhor = yy
zhor = xx*cos(lat/rad) + zz*sin(lat/rad)
Az = mod(rad*atan2(yhor,xhor) + 180.0 + 360.0,360.0)
El = rad*asin(zhor)
day=d-1.5
return
end subroutine sun

142
qmap/libqmap/symspec.f90 Normal file
View File

@ -0,0 +1,142 @@
subroutine symspec(k,ndiskdat,nb,nbslider,nfsample, &
pxdb,ssz5a,nkhz,ihsym,nzap,slimit,lstrong)
! k pointer to the most recent new data
! ndiskdat 0/1 to indicate if data from disk
! nb 0/1 status of noise blanker
! nfsample sample rate (Hz)
! pxdb power in x channel (0-60 dB)
! ssz5a polarized spectrum, for waterfall display
! nkhz integer kHz portion of center frequency, e.g., 125 for 144.125
! ihsym index number of this half-symbol (1-322)
! nzap number of samples zero'ed by noise blanker
include 'njunk.f90'
parameter (NSMAX=60*96000) !Total sample intervals per minute
parameter (NFFT=32768) !Length of FFTs
real*8 ts,hsym
real*8 fcenter
common/datcom/dd(2,5760000),ss(322,NFFT),savg(NFFT),fcenter,nutc, &
junk(NJUNK)
real*4 ssz5a(NFFT),w(NFFT),w2a(NFFT),w2b(NFFT)
complex cx(NFFT)
complex cx00(NFFT)
complex cx0(0:1023),cx1(0:1023)
logical*1 lstrong(0:1023)
data rms/999.0/,k0/99999999/,nadjx/0/,nadjy/0/
save
nfast=1
if(k.gt.5751000) go to 999
if(k.lt.NFFT) then
ihsym=0
go to 999 !Wait for enough samples to start
endif
if(k0.eq.99999999) then
pi=4.0*atan(1.0)
w2a=0.
w2b=0.
do i=1,NFFT
w(i)=(sin(i*pi/NFFT))**2 !Window for nfast=1
if(i.lt.17833) w2a(i)=(sin(i*pi/17832.925))**2 !Window a for nfast=2
j=i-8916
if(j.gt.0 .and. j.lt.17833) w2b(i)=(sin(j*pi/17832.925))**2 ! b
enddo
w2a=sqrt(2.0)*w2a
w2b=sqrt(2.0)*w2b
endif
hsym=2048.d0*96000.d0/11025.d0 !Samples per JT65 half-symbol
if(nfsample.eq.95238) hsym=2048.d0*95238.1d0/11025.d0
if(k.lt.k0) then
ts=1.d0 - hsym
savg=0.
ihsym=0
k1=0
if(ndiskdat.eq.0) dd(1:2,k+1:5760000)=0. !### Should not be needed ??? ###
endif
k0=k
nzap=0
sigmas=1.5*(10.0**(0.01*nbslider)) + 0.7
peaklimit=sigmas*max(10.0,rms)
faclim=3.0
px=0.
nwindow=2
nfft2=1024
kstep=nfft2
if(nwindow.ne.0) kstep=nfft2/2
nblks=(k-k1)/kstep
do nblk=1,nblks
j=k1+1
do i=0,nfft2-1
cx0(i)=cmplx(dd(1,j+i),dd(2,j+i))
enddo
call timf2(k,nfft2,nwindow,nb,peaklimit, &
faclim,cx0,cx1,slimit,lstrong, &
px,nzap)
do i=0,kstep-1
dd(1,j+i)=real(cx1(i))
dd(2,j+i)=aimag(cx1(i))
enddo
k1=k1+kstep
enddo
npts=NFFT !Samples used in each half-symbol FFT
ts=ts+hsym
ja=ts !Index of first sample
jb=ja+npts-1 !Last sample
i=0
fac=0.0002
do j=ja,jb !Copy data into cx
x1=dd(1,j)
x2=dd(2,j)
i=i+1
cx(i)=fac*cmplx(x1,x2)
enddo
if(nzap/178.lt.50 .and. (ndiskdat.eq.0 .or. ihsym.lt.280)) then
nsum=nblks*kstep - nzap
if(nsum.le.0) nsum=1
rmsx=sqrt(0.5*px/nsum)
rms=rmsx
endif
pxdb=0.
if(rmsx.gt.1.0) pxdb=20.0*log10(rmsx)
if(pxdb.gt.60.0) pxdb=60.0
cx00=cx
do mm=1,nfast
ihsym=ihsym+1
if(nfast.eq.1) then
cx=w*cx00 !Apply window for 2nd forward FFT
else
if(mm.eq.1) then
cx=w2a*cx00
else
cx=w2b*cx00
endif
endif
call four2a(cx,NFFT,1,1,1) !Second forward FFT (X)
n=min(322,ihsym)
do i=1,NFFT
sx=real(cx(i))**2 + aimag(cx(i))**2
ss(n,i)=sx ! Pol = 0
savg(i)=savg(i) + sx
ssz5a(i)=sx
enddo
enddo
nkhz=nint(1000.d0*(fcenter-int(fcenter)))
if(fcenter.eq.0.d0) nkhz=125
999 return
end subroutine symspec

84
qmap/libqmap/synctst.f90 Normal file
View File

@ -0,0 +1,84 @@
program synctst
! Tests JT65B2 sync patterns
parameter (LAGMAX=20)
real ccf0(0:LAGMAX),ccf2(0:LAGMAX),ccf3(0:LAGMAX)
character*12 arg
integer npr(126),np0(126),np1(126),npr2(126)
data npr/1,0,0,1,1,0,0,0,1,1,1,1,1,1,0,1,0,1,0,0, &
0,1,0,1,1,0,0,1,0,0,0,1,1,1,0,0,1,1,1,1, &
0,1,1,0,1,1,1,1,0,0,0,1,1,0,1,0,1,0,1,1, &
0,0,1,1,0,1,0,1,0,1,0,0,1,0,0,0,0,0,0,1, &
1,0,0,0,0,0,0,0,1,1,0,1,0,0,1,0,1,1,0,1, &
0,1,0,1,0,0,1,1,0,0,1,0,0,1,0,0,0,0,1,1, &
1,1,1,1,1,1/
nargs=iargc()
if(nargs.ne.1) then
print*,'Usage: synctst iters'
go to 999
endif
call getarg(1,arg)
read(arg,*) iters
worst=0.
do lag=0,LAGMAX
nsum=0
do i=1,126-lag
nsum=nsum + npr(i)*npr(lag+i)
enddo
ccf0(lag)=2.0*nsum/(126.0-lag)
if(lag.ge.1 .and. ccf0(lag).gt.worst) worst=ccf0(lag)
enddo
best2=1.0
do iter=1,iters
10 np0=0
np1=0
n0=0
do i=1,126
if(npr(i).eq.1) then
call random_number(r)
if(r.lt.0.5) then
np0(i)=1
n0=n0+1
else
np1(i)=1
endif
endif
enddo
if(n0.ne.31 .and. n0.ne.32) go to 10
worst2=0.
do lag=0,LAGMAX
nsum=0
do i=1,126-lag
nsum=nsum + np0(i)*np0(lag+i) + np1(i)*np1(lag+i)
enddo
ccf2(lag)=2.0*nsum/(126.0-lag)
if(lag.ge.1 .and. ccf2(lag).gt.worst2) then
worst2=ccf2(lag)
lagbad=lag
endif
enddo
if(worst2.lt.best2) then
best2=worst2
lagbest=lagbad
n0best=n0
ccf3=ccf2
npr2=np0 + 2*np1
endif
enddo
do lag=0,LAGMAX
write(13,1100) lag,ccf0(lag),ccf3(lag)
1100 format(i3,2f10.3)
enddo
print*,worst,best2,n0best,lagbest
write(*,1110) npr2
1110 format((8x,20(i1,',')))
999 end program synctst

91
qmap/libqmap/synctst2.f90 Normal file
View File

@ -0,0 +1,91 @@
program synctst2
! Tests JT65B2 sync patterns
parameter (LAGMAX=20)
real ccf0(0:LAGMAX),ccf1(0:LAGMAX),ccf2(0:LAGMAX),ccf3(0:LAGMAX)
character arg*12,line*64
integer*8 n8
integer npr(126),np0(126),np1(126),npr1(126),npr2(126)
data npr/1,0,0,1,1,0,0,0,1,1,1,1,1,1,0,1,0,1,0,0, &
0,1,0,1,1,0,0,1,0,0,0,1,1,1,0,0,1,1,1,1, &
0,1,1,0,1,1,1,1,0,0,0,1,1,0,1,0,1,0,1,1, &
0,0,1,1,0,1,0,1,0,1,0,0,1,0,0,0,0,0,0,1, &
1,0,0,0,0,0,0,0,1,1,0,1,0,0,1,0,1,1,0,1, &
0,1,0,1,0,0,1,1,0,0,1,0,0,1,0,0,0,0,1,1, &
1,1,1,1,1,1/
data npr2/1,0,0,1,2,0,0,0,2,1,1,2,2,2,0,2,0,2,0,0, &
0,1,0,2,1,0,0,1,0,0,0,2,1,1,0,0,1,1,2,2, &
0,2,2,0,2,1,1,1,0,0,0,1,2,0,1,0,2,0,1,1, &
0,0,2,2,0,1,0,1,0,2,0,0,2,0,0,0,0,0,0,1, &
1,0,0,0,0,0,0,0,1,2,0,2,0,0,2,0,2,1,0,1, &
0,2,0,1,0,0,2,2,0,0,1,0,0,2,0,0,0,0,1,1, &
1,2,1,2,1,2/
data n8/x'4314f4725bb357e0'/
write(*,1102) n8
write(line,1102) n8
1102 format(b63)
read(line,1104) npr1(1:63)
1104 format(63i1)
npr1(64:126)=npr1(1:63)
worst=0.
do lag=0,LAGMAX
nsum=0
do i=1,126-lag
nsum=nsum + npr(i)*npr(lag+i)
enddo
ccf0(lag)=2.0*nsum/(126.0-lag)
if(lag.ge.1 .and. ccf0(lag).gt.worst) worst=ccf0(lag)
enddo
worst1=0.
do lag=0,LAGMAX
nsum=0
do i=1,126-lag
nsum=nsum + npr1(i)*npr1(lag+i)
enddo
ccf1(lag)=(63.0/64.0)*2.0*nsum/(126.0-lag)
if(lag.ge.1 .and. ccf1(lag).gt.worst1) worst1=ccf1(lag)
enddo
ccf1=ccf1/ccf1(0)
worst1=worst1/ccf1(0)
np0=0
np1=0
n0=0
do i=1,126
if(npr2(i).eq.1) then
np0(i)=1
n0=n0+1
else if(npr2(i).eq.2) then
np1(i)=1
endif
enddo
worst2=0.
do lag=0,LAGMAX
nsum=0
do i=1,126-lag
nsum=nsum + np0(i)*np0(lag+i) + np1(i)*np1(lag+i)
enddo
ccf2(lag)=2.0*nsum/(126.0-lag)
if(lag.ge.1 .and. ccf2(lag).gt.worst2) then
worst2=ccf2(lag)
lagbad=lag
endif
enddo
do lag=0,LAGMAX
write(13,1100) lag,ccf0(lag),ccf1(lag),ccf2(lag)
1100 format(i3,3f10.3)
enddo
print*,worst,worst1,worst2,n0,lagbad
999 end program synctst2

35
qmap/libqmap/tastro.f90 Normal file
View File

@ -0,0 +1,35 @@
program tastro
implicit real*8 (a-h,o-z)
character grid*6
character*9 cauxra,cauxdec
character*12 clock(3)
integer nt(8)
equivalence (nt(1),nyear)
grid='FN20qi'
nfreq=144
cauxra='00:00:00'
10 call date_and_time(clock(1),clock(2),clock(3),nt)
ih=ihour-ntz/60
if(ih.le.0) then
ih=ih+24
nday=nday+1
endif
uth8=ih + imin/60.d0 + isec/3600.d0 + ims/3600000.d0
call 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,width1,width2,w501,w502,xlst8)
write(*,1010) nyear,month,nday,ih,imin,isec,AzMoon8,ElMoon8, &
AzSun8,ElSun8,ndop,dgrd8,ntsky
1010 format(i4,i3,i3,i4.2,':',i2.2,':',i2.2,4f8.1,i6,f6.1,i6)
call system('sleep 1')
go to 10
end program tastro

Some files were not shown because too many files have changed in this diff Show More