QRA66 now works up for submodes A-D up to 300 s periods. Submode E presently NG.

lib/decoder.f90

@@ -197,8 +197,9 @@ subroutine multimode_decoder(ss,id2,params,nfsample)
   if(params%nmode.eq.66) then
 ! We're in QRA66 mode
      call timer('decqra66',0)
-     call my_qra66%decode(qra66_decoded,id2,params%nutc,params%ntr,          &
+     call my_qra66%decode(qra66_decoded,id2,params%nutc,params%ntr,        &
-          params%nfqso,params%ntol,params%ndepth,mycall,hiscall,hisgrid)
+          params%nsubmode,params%nfqso,params%ntol,params%ndepth,          &
+          mycall,hiscall,hisgrid)
      call timer('decqra66',1)
      go to 800
   endif
@@ -209,7 +210,7 @@ subroutine multimode_decoder(ss,id2,params,nfsample)
      iwspr=0
      if(iand(params%ndepth,128).ne.0) iwspr=2
      call timer('dec240  ',0)
-     call my_fst4%decode(fst4_decoded,id2,params%nutc,                &
+     call my_fst4%decode(fst4_decoded,id2,params%nutc,                    &
           params%nQSOProgress,params%nfqso,params%nfa,params%nfb,         &
           params%nsubmode,ndepth,params%ntr,params%nexp_decode,           &
           params%ntol,params%emedelay,                                    &

lib/qra66_decode.f90

@@ -28,8 +28,8 @@ module qra66_decode
 
 contains
 
-  subroutine decode(this,callback,iwave,nutc,ntrperiod,nfqso,ntol,ndepth,   &
+  subroutine decode(this,callback,iwave,nutc,ntrperiod,nsubmode,nfqso,   &
-       mycall,hiscall,hisgrid)
+       ntol,ndepth,mycall,hiscall,hisgrid)
 
     use timer_module, only: timer
     use packjt
@@ -44,16 +44,24 @@ contains
     integer dat4(12)
     logical lapdx,ltext
     complex, allocatable :: c0(:)         !Analytic signal, 6000 S/s
-    real s3(-64:127,63)
+    real, allocatable, save :: s3(:,:)    !Symbol spectra
-    real s3a(-64:127,63)
+    real, allocatable, save :: s3a(:,:)   !Symbol spectra for avg messages
     real a(5)
-    data nc1z/-1/,nc2z/-1/,ng2z/-1/,maxaptypez/-1/
+    data nc1z/-1/,nc2z/-1/,ng2z/-1/,maxaptypez/-1/,nsubmodez/-1/
-    save nc1z,nc2z,ng2z,maxaptypez,nsave,s3a
+    save nc1z,nc2z,ng2z,maxaptypez,nsave,nsubmodez
 
+    mode66=2**nsubmode
     nfft1=ntrperiod*12000
     nfft2=ntrperiod*6000
     allocate (c0(0:nfft1-1))
 
+    if(nsubmode.ne.nsubmodez) then
+       if(allocated(s3)) deallocate(s3)
+       if(allocated(s3a)) deallocate(s3a)
+       allocate(s3(-64:64*mode66+63,63))
+       allocate(s3a(-64:64*mode66+63,63))
+    endif
+    
     if(ntrperiod.eq.15) then
        nsps=1800
     else if(ntrperiod.eq.30) then
@@ -83,7 +91,6 @@ contains
     call packcall(mycall(1:6),nc1,ltext)
     call packcall(hiscall(1:6),nc2,ltext)
     call packgrid(hisgrid(1:4),ng2,ltext)
-    nSubmode=0
     b90=20.0                 !8 to 25 is OK; not very critical
     nFadingModel=1
 
@@ -116,28 +123,31 @@ contains
     c0(0)=0.5*c0(0)
     call four2a(c0,nfft2,1,1,1)            !Inverse c2c FFT
     call timer('sync66  ',0)
-    call sync66(iwave,ntrperiod*12000,nsps,nfqso,ntol,xdt,f0,snr1)
+    call sync66(iwave,ntrperiod*12000,mode66,nsps,nfqso,ntol,xdt,f0,snr1)
     call timer('sync66  ',1)
+    
     jpk=(xdt+0.5)*6000 - 384                       !### Empirical ###
     if(ntrperiod.ge.60) jpk=(xdt+1.0)*6000 - 384   !### TBD ###
     if(jpk.lt.0) jpk=0
     a=0.
-    a(1)=-(f0 + 2.0*baud)                  !Data tones start 2 bins higher
+    a(1)=-(f0 + 2.0*mode66*baud)             !Data tones start 2*mode66 bins higher
     call twkfreq(c0,c0,ntrperiod*6000,6000.0,a)
     xdt=jpk/6000.0 - 0.5
-    call spec66(c0(jpk:),nsps/2,s3)
+    
+    LL=64*(mode66+2)
+    NN=63
+    call spec66(c0(jpk:),nsps/2,s3,LL,NN)  !Compute the synchronized symbol spectra
 
     do j=1,63                              !Normalize to symbol baseline
-       call pctile(s3(:,j),192,40,base)
+       call pctile(s3(:,j),LL,40,base)
        s3(:,j)=s3(:,j)/base
-!       write(71,3071)j,maxloc(s3(:,j))
-!3071   format(2i5)
     enddo
 
+    LL2=64*(mode66+1)-1
     s3max=20.0
     do j=1,63                              !Apply AGC to suppress pings
-     xx=maxval(s3(-64:127,j))
+     xx=maxval(s3(-64:LL2,j))
-     if(xx.gt.s3max) s3(-64:127,j)=s3(-64:127,j)*s3max/xx
+     if(xx.gt.s3max) s3(-64:LL2,j)=s3(-64:LL2,j)*s3max/xx
     enddo
 
 ! Call Nico's QRA64 decoder

lib/spec66.f90

@@ -1,11 +1,11 @@
-subroutine spec66(c0,nsps,s3)
+subroutine spec66(c0,nsps,s3,LL,NN)
+
+! Compute synchronized symbol spectra.  
 
-  parameter (LL=3*64)                    !Frequency channels
-  parameter (NN=63)                      !Data symbols
   complex c0(0:85*nsps-1)                !Synchronized complex data at 6000 S/s
   complex cs(0:nsps-1)                   !Complex symbol spectrum
   real s3(LL,NN)                         !Synchronized symbol spectra
-  real xbase0(LL),xbase(LL)
+  real xbase0(LL),xbase(LL)              !Work arrays
 
   fac=1.0/nsps
   ja=-nsps

lib/sync66.f90

@@ -1,4 +1,4 @@
-subroutine sync66(iwave,nmax,nsps,nfqso,ntol,xdt,f0,snr1)
+subroutine sync66(iwave,nmax,mode66,nsps,nfqso,ntol,xdt,f0,snr1)
 
   parameter (NSTEP=4)                      !Quarter-symbol steps
   integer*2 iwave(0:nmax-1)                !Raw data
@@ -35,7 +35,7 @@ subroutine sync66(iwave,nmax,nsps,nfqso,ntol,xdt,f0,snr1)
   endif
 
   fac=1/32767.0
-  do j=1,jz                          !Compute symbol spectra at quarter-symbol steps
+  do j=1,jz                     !Compute symbol spectra at quarter-symbol steps
      ia=(j-1)*istep
      ib=ia+nsps-1
      k=-1
@@ -66,9 +66,9 @@ subroutine sync66(iwave,nmax,nsps,nfqso,ntol,xdt,f0,snr1)
   sync_sig=0.
   ia=min(64,nint(ntol/df))
   dt4=nsps/(NSTEP*12000.0)                      !duration of 1/4 symbol
-  lag2=nint(0.5/dt4)
+!  lag2=nint(0.5/dt4)
-  if(nsps.ge.7680) lag2=nint(1.0/dt4)
+!  if(nsps.ge.7680) lag2=nint(1.0/dt4)
-  lag1=-lag2
+!  lag1=-lag2
 
   jadd=11
   if(nsps.ge.3600) jadd=7
@@ -77,7 +77,7 @@ subroutine sync66(iwave,nmax,nsps,nfqso,ntol,xdt,f0,snr1)
   if(nsps.ge.41472) jadd=1
   
   do i=-ia,ia
-     x=s1(i0+2+i,:)-s1(i0+i,:)                  !Do the 2FSK demodulation
+     x=s1(i0+2*mode66+i,:)-s1(i0+i,:)              !Do the 2FSK demodulation
 !     do lag=lag1,lag2
      do lag=-15,15
         do k=1,22