1module q65_decode
2
3  integer nsnr0,nfreq0
4  real xdt0
5  character msg0*37,cq0*3
6
7  type :: q65_decoder
8     procedure(q65_decode_callback), pointer :: callback
9   contains
10     procedure :: decode
11  end type q65_decoder
12
13  abstract interface
14     subroutine q65_decode_callback (this,nutc,snr1,nsnr,dt,freq,    &
15          decoded,idec,nused,ntrperiod)
16       import q65_decoder
17       implicit none
18       class(q65_decoder), intent(inout) :: this
19       integer, intent(in) :: nutc
20       real, intent(in) :: snr1
21       integer, intent(in) :: nsnr
22       real, intent(in) :: dt
23       real, intent(in) :: freq
24       character(len=37), intent(in) :: decoded
25       integer, intent(in) :: idec
26       integer, intent(in) :: nused
27       integer, intent(in) :: ntrperiod
28     end subroutine q65_decode_callback
29  end interface
30
31contains
32
33  subroutine decode(this,callback,iwave,nqd0,nutc,ntrperiod,nsubmode,nfqso,  &
34       ntol,ndepth,nfa0,nfb0,lclearave,single_decode,lagain,max_drift0,      &
35       lnewdat0,emedelay,mycall,hiscall,hisgrid,nQSOprogress,ncontest,       &
36       lapcqonly,navg0)
37
38! Top-level routine that organizes the decoding of Q65 signals
39! Input:  iwave            Raw data, i*2
40!         nutc             UTC for time-tagging the decode
41!         ntrperiod        T/R sequence length (s)
42!         nsubmode         Tone-spacing indicator, 0-4 for A-E
43!         nfqso            Target signal frequency (Hz)
44!         ntol             Search range around nfqso (Hz)
45!         ndepth           Optional decoding level
46!         lclearave        Flag to clear the message-averaging arrays
47!         emedelay         Sync search extended to cover EME delays
48!         nQSOprogress     Auto-sequencing state for the present QSO
49!         ncontest         Supported contest type
50!         lapcqonly        Flag to use AP only for CQ calls
51! Output: sent to the callback routine for display to user
52
53    use timer_module, only: timer
54    use packjt77
55    use, intrinsic :: iso_c_binding
56    use q65                               !Shared variables
57    use prog_args
58
59    parameter (NMAX=300*12000)            !Max TRperiod is 300 s
60    class(q65_decoder), intent(inout) :: this
61    procedure(q65_decode_callback) :: callback
62    character(len=12) :: mycall, hiscall  !Used for AP decoding
63    character(len=6) :: hisgrid
64    character*37 decoded                  !Decoded message
65    character*77 c77
66    character*78 c78
67    character*6 cutc
68    character c6*6,c4*4,cmode*4
69    character*80 fmt
70    integer*2 iwave(NMAX)                 !Raw data
71    real, allocatable :: dd(:)            !Raw data
72    integer dat4(13)                      !Decoded message as 12 6-bit integers
73    integer dgen(13)
74    logical lclearave,lnewdat0,lapcqonly,unpk77_success
75    logical single_decode,lagain
76    complex, allocatable :: c00(:)        !Analytic signal, 6000 Sa/s
77    complex, allocatable :: c0(:)         !Analytic signal, 6000 Sa/s
78
79! Start by setting some parameters and allocating storage for large arrays
80    call sec0(0,tdecode)
81    nfa=nfa0
82    nfb=nfb0
83    nqd=nqd0
84    lnewdat=lnewdat0
85    max_drift=max_drift0
86    idec=-1
87    idf=0
88    idt=0
89    nrc=-2
90    mode_q65=2**nsubmode
91    npts=ntrperiod*12000
92    nfft1=ntrperiod*12000
93    nfft2=ntrperiod*6000
94    npasses=1
95
96! Determine the T/R sequence: iseq=0 (even), or iseq=1 (odd)
97    n=nutc
98    if(ntrperiod.ge.60 .and. nutc.le.2359) n=100*n
99    write(cutc,'(i6.6)') n
100    read(cutc,'(3i2)') ih,im,is
101    nsec=3600*ih + 60*im + is
102    iseq=mod(nsec/ntrperiod,2)
103
104    if(lclearave) call q65_clravg
105    allocate(dd(npts))
106    allocate (c00(0:nfft1-1))
107    allocate (c0(0:nfft1-1))
108
109    if(lagain) then
110       call q65_hist(nfqso,dxcall=hiscall,dxgrid=hisgrid)
111    endif
112
113    nsps=1800
114    if(ntrperiod.eq.30) then
115       nsps=3600
116    else if(ntrperiod.eq.60) then
117       nsps=7200
118    else if(ntrperiod.eq.120) then
119       nsps=16000
120    else if(ntrperiod.eq.300) then
121       nsps=41472
122    endif
123
124    baud=12000.0/nsps
125    this%callback => callback
126    nFadingModel=1
127    maxiters=33
128    ibwa=max(1,int(1.8*log(baud*mode_q65)) + 1)
129    ibwb=min(10,ibwa+2)
130    if(iand(ndepth,3).ge.2) then
131       ibwa=max(1,int(1.8*log(baud*mode_q65)) + 1)
132       ibwb=min(10,ibwa+5)
133       maxiters=67
134    else if(iand(ndepth,3).eq.3) then
135       ibwa=max(1,ibwa-1)
136       ibwb=min(10,ibwb+1)
137       maxiters=100
138    endif
139! Generate codewords for full-AP list decoding
140    if(ichar(hiscall(1:1)).eq.0) hiscall=' '
141    if(ichar(hisgrid(1:1)).eq.0) hisgrid=' '
142    ncw=0
143    if(nqd.eq.1 .or. lagain) then
144       call q65_set_list(mycall,hiscall,hisgrid,codewords,ncw)
145    endif
146    dgen=0
147    call q65_enc(dgen,codewords)         !Initialize the Q65 codec
148    nused=1
149    iavg=0
150    call timer('q65_dec0',0)
151! Call top-level routine in q65 module: establish sync and try for a
152! q3 or q0 decode.
153    call q65_dec0(iavg,nutc,iwave,ntrperiod,nfqso,ntol,ndepth,lclearave,  &
154         emedelay,xdt,f0,snr1,width,dat4,snr2,idec)
155    call timer('q65_dec0',1)
156!    write(*,3001) '=a',sum(abs(float(iwave))),nfqso,ntol,ndepth,xdt,f0,idec
157!3001 format(a2,f15.0,3i5,f7.2,f7.1,i5)
158
159    if(idec.ge.0) then
160       dtdec=xdt                    !We have a q3 or q0 decode at nfqso
161       f0dec=f0
162       go to 100
163    endif
164
165! Prepare for a single-period decode with iaptype = 0, 1, 2, or 4
166    jpk0=(xdt+1.0)*6000                      !Index of nominal start of signal
167    if(ntrperiod.le.30) jpk0=(xdt+0.5)*6000  !For shortest sequences
168    if(jpk0.lt.0) jpk0=0
169    call ana64(iwave,npts,c00)          !Convert to complex c00() at 6000 Sa/s
170    call ft8apset(mycall,hiscall,ncontest,apsym0,aph10) ! Generate ap symbols
171    where(apsym0.eq.-1) apsym0=0
172
173    npasses=2
174    if(nQSOprogress.eq.5) npasses=3
175    if(lapcqonly) npasses=1
176    iaptype=0
177    do ipass=0,npasses                  !Loop over AP passes
178       apmask=0                         !Try first with no AP information
179       apsymbols=0
180       if(ipass.ge.1) then
181          ! Subsequent passes use AP information appropiate for nQSOprogress
182          call q65_ap(nQSOprogress,ipass,ncontest,lapcqonly,iaptype,   &
183               apsym0,apmask1,apsymbols1)
184          write(c78,1050) apmask1
1851050      format(78i1)
186          read(c78,1060) apmask
1871060      format(13b6.6)
188          write(c78,1050) apsymbols1
189          read(c78,1060) apsymbols
190       endif
191
192       call timer('q65loops',0)
193       call q65_loops(c00,npts/2,nsps/2,nsubmode,ndepth,jpk0,   &
194            xdt,f0,iaptype,xdt1,f1,snr2,dat4,idec)
195       call timer('q65loops',1)
196       if(idec.ge.0) then
197          dtdec=xdt1
198          f0dec=f1
199          go to 100       !Successful decode, we're done
200       endif
201    enddo  ! ipass
202
203    if(iand(ndepth,16).eq.0 .or. navg(iseq).lt.2) go to 100
204
205! There was no single-transmission decode. Try for an average 'q3n' decode.
20650  call timer('list_avg',0)
207! Call top-level routine in q65 module: establish sync and try for a q3
208! decode, this time using the cumulative 's1a' symbol spectra.
209    iavg=1
210    call q65_dec0(iavg,nutc,iwave,ntrperiod,nfqso,ntol,ndepth,lclearave,  &
211         emedelay,xdt,f0,snr1,width,dat4,snr2,idec)
212    call timer('list_avg',1)
213
214    if(idec.ge.0) then
215       dtdec=xdt               !We have a list-decode result from averaged data
216       f0dec=f0
217       nused=navg(iseq)
218       go to 100
219    endif
220
221! There was no 'q3n' decode.  Try for a 'q[0124]n' decode.
222! Call top-level routine in q65 module: establish sync and try for a q[012]n
223! decode, this time using the cumulative 's1a' symbol spectra.
224
225    call timer('q65_avg ',0)
226    iavg=2
227    call q65_dec0(iavg,nutc,iwave,ntrperiod,nfqso,ntol,ndepth,lclearave,  &
228         emedelay,xdt,f0,snr1,width,dat4,snr2,idec)
229    call timer('q65_avg ',1)
230    if(idec.ge.0) then
231       dtdec=xdt                          !We have a q[012]n result
232       f0dec=f0
233       nused=navg(iseq)
234    endif
235
236100 decoded='                                     '
237    if(idec.ge.0) then
238! idec Meaning
239! ------------------------------------------------------
240! -1:  No decode
241!  0:  Decode without AP information
242!  1:  Decode with AP for "CQ        ?   ?"
243!  2:  Decode with AP for "MyCall    ?   ?"
244!  3:  Decode with AP for "MyCall DxCall ?"
245
246! Unpack decoded message for display to user
247       write(c77,1000) dat4(1:12),dat4(13)/2
2481000   format(12b6.6,b5.5)
249       call unpack77(c77,0,decoded,unpk77_success) !Unpack to get msgsent
250       call q65_snr(dat4,dtdec,f0dec,mode_q65,nused,snr2)
251       nsnr=nint(snr2)
252       call this%callback(nutc,snr1,nsnr,dtdec,f0dec,decoded,    &
253            idec,nused,ntrperiod)
254       call q65_hist(nint(f0dec),msg0=decoded)
255       if(iand(ndepth,128).ne.0 .and. .not.lagain .and.      &
256            int(abs(f0dec-nfqso)).le.ntol ) call q65_clravg    !AutoClrAvg
257       call sec0(1,tdecode)
258       open(22,file=trim(data_dir)//'/q65_decodes.dat',status='unknown',     &
259            position='append',iostat=ios)
260       if(ios.eq.0) then
261! Save decoding parameters to q65_decoded.dat, for later analysis.
262          write(cmode,'(i3)') ntrperiod
263          cmode(4:4)=char(ichar('A')+nsubmode)
264          c6=hiscall(1:6)
265          if(c6.eq.'      ') c6='<b>   '
266          c4=hisgrid(1:4)
267          if(c4.eq.'    ') c4='<b> '
268          fmt='(i6.4,1x,a4,4i2,6i3,i4,f6.2,f7.1,f6.1,f7.1,f6.2,'//   &
269               '1x,a6,1x,a6,1x,a4,1x,a)'
270          if(ntrperiod.le.30) fmt(5:5)='6'
271          if(idec.eq.3) nrc=0
272          write(22,fmt) nutc,cmode,nQSOprogress,idec,idfbest,idtbest,ibw,    &
273               ndistbest,nused,icand,ncand,nrc,ndepth,xdt,f0,snr2,plog,      &
274               tdecode,mycall(1:6),c6,c4,trim(decoded)
275          close(22)
276       endif
277    endif
278    navg0=1000*navg(0) + navg(1)
279    if(single_decode .or. lagain) go to 900
280
281    do icand=1,ncand
282! Prepare for single-period candidate decodes with iaptype = 0, 1, 2, or 4
283       snr1=candidates(icand,1)
284       xdt= candidates(icand,2)
285       f0 = candidates(icand,3)
286       jpk0=(xdt+1.0)*6000                   !Index of nominal start of signal
287       if(ntrperiod.le.30) jpk0=(xdt+0.5)*6000  !For shortest sequences
288       if(jpk0.lt.0) jpk0=0
289       call ana64(iwave,npts,c00)       !Convert to complex c00() at 6000 Sa/s
290       call ft8apset(mycall,hiscall,ncontest,apsym0,aph10) ! Generate ap symbols
291       where(apsym0.eq.-1) apsym0=0
292
293       npasses=2
294       if(nQSOprogress.eq.5) npasses=3
295       if(lapcqonly) npasses=1
296       iaptype=0
297       do ipass=0,npasses                  !Loop over AP passes
298          apmask=0                         !Try first with no AP information
299          apsymbols=0
300          if(ipass.ge.1) then
301          ! Subsequent passes use AP information appropiate for nQSOprogress
302             call q65_ap(nQSOprogress,ipass,ncontest,lapcqonly,iaptype,   &
303                  apsym0,apmask1,apsymbols1)
304             write(c78,1050) apmask1
305             read(c78,1060) apmask
306             write(c78,1050) apsymbols1
307             read(c78,1060) apsymbols
308          endif
309
310          call timer('q65loops',0)
311          call q65_loops(c00,npts/2,nsps/2,nsubmode,ndepth,jpk0,   &
312               xdt,f0,iaptype,xdt1,f1,snr2,dat4,idec)
313          call timer('q65loops',1)
314          if(idec.ge.0) then
315             dtdec=xdt1
316             f0dec=f1
317             go to 200       !Successful decode, we're done
318          endif
319       enddo  ! ipass
320
321200    decoded='                                     '
322       if(idec.ge.0) then
323! Unpack decoded message for display to user
324          write(c77,1000) dat4(1:12),dat4(13)/2
325          call unpack77(c77,0,decoded,unpk77_success) !Unpack to get msgsent
326          call q65_snr(dat4,dtdec,f0dec,mode_q65,nused,snr2)
327          nsnr=nint(snr2)
328          call this%callback(nutc,snr1,nsnr,dtdec,f0dec,decoded,    &
329               idec,nused,ntrperiod)
330          call q65_hist(nint(f0dec),msg0=decoded)
331          if(iand(ndepth,128).ne.0 .and. .not.lagain .and.      &
332               int(abs(f0dec-nfqso)).le.ntol ) call q65_clravg    !AutoClrAvg
333          call sec0(1,tdecode)
334          open(22,file=trim(data_dir)//'/q65_decodes.dat',status='unknown',     &
335               position='append',iostat=ios)
336          if(ios.eq.0) then
337! Save decoding parameters to q65_decoded.dat, for later analysis.
338             write(cmode,'(i3)') ntrperiod
339             cmode(4:4)=char(ichar('A')+nsubmode)
340             c6=hiscall(1:6)
341             if(c6.eq.'      ') c6='<b>   '
342             c4=hisgrid(1:4)
343             if(c4.eq.'    ') c4='<b> '
344             fmt='(i6.4,1x,a4,4i2,6i3,i4,f6.2,f7.1,f6.1,f7.1,f6.2,'//   &
345                  '1x,a6,1x,a6,1x,a4,1x,a)'
346             if(ntrperiod.le.30) fmt(5:5)='6'
347             if(idec.eq.3) nrc=0
348             write(22,fmt) nutc,cmode,nQSOprogress,idec,idfbest,idtbest,ibw,  &
349                  ndistbest,nused,icand,ncand,nrc,ndepth,xdt,f0,snr2,plog,    &
350                  tdecode,mycall(1:6),c6,c4,trim(decoded)
351             close(22)
352          endif
353       endif
354    enddo  ! icand
355    if(iavg.eq.0 .and.navg(iseq).ge.2 .and. iand(ndepth,16).ne.0) go to 50
356900 return
357  end subroutine decode
358
359end module q65_decode
360