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