430 lines
		
	
	
		
			13 KiB
		
	
	
	
		
			Fortran
		
	
	
	
	
	
			
		
		
	
	
			430 lines
		
	
	
		
			13 KiB
		
	
	
	
		
			Fortran
		
	
	
	
	
	
| subroutine multimode_decoder(ss,id2,params,nfsample)
 | |
| 
 | |
|   !$ use omp_lib
 | |
|   use prog_args
 | |
|   use timer_module, only: timer
 | |
|   use jt4_decode
 | |
|   use jt65_decode
 | |
|   use jt9_decode
 | |
|   use ft8_decode
 | |
| 
 | |
|   include 'jt9com.f90'
 | |
|   include 'timer_common.inc'
 | |
| 
 | |
|   type, extends(jt4_decoder) :: counting_jt4_decoder
 | |
|      integer :: decoded
 | |
|   end type counting_jt4_decoder
 | |
| 
 | |
|   type, extends(jt65_decoder) :: counting_jt65_decoder
 | |
|      integer :: decoded
 | |
|   end type counting_jt65_decoder
 | |
| 
 | |
|   type, extends(jt9_decoder) :: counting_jt9_decoder
 | |
|      integer :: decoded
 | |
|   end type counting_jt9_decoder
 | |
| 
 | |
|   type, extends(ft8_decoder) :: counting_ft8_decoder
 | |
|      integer :: decoded
 | |
|   end type counting_ft8_decoder
 | |
| 
 | |
|   real ss(184,NSMAX)
 | |
|   logical baddata,newdat65,newdat9,single_decode,bVHF,bad0,newdat
 | |
|   integer*2 id2(NTMAX*12000)
 | |
|   type(params_block) :: params
 | |
|   real*4 dd(NTMAX*12000)
 | |
|   save
 | |
|   type(counting_jt4_decoder) :: my_jt4
 | |
|   type(counting_jt65_decoder) :: my_jt65
 | |
|   type(counting_jt9_decoder) :: my_jt9
 | |
|   type(counting_ft8_decoder) :: my_ft8
 | |
| 
 | |
|   ! initialize decode counts
 | |
|   my_jt4%decoded = 0
 | |
|   my_jt65%decoded = 0
 | |
|   my_jt9%decoded = 0
 | |
|   my_ft8%decoded = 0
 | |
| 
 | |
|   single_decode=iand(params%nexp_decode,32).ne.0
 | |
|   bVHF=iand(params%nexp_decode,64).ne.0
 | |
|   if(mod(params%nranera,2).eq.0) ntrials=10**(params%nranera/2)
 | |
|   if(mod(params%nranera,2).eq.1) ntrials=3*10**(params%nranera/2)
 | |
|   if(params%nranera.eq.0) ntrials=0
 | |
|   
 | |
|   nfail=0
 | |
| 10 if (params%nagain) then
 | |
|      open(13,file=trim(temp_dir)//'/decoded.txt',status='unknown',            &
 | |
|           position='append',iostat=ios)
 | |
|   else
 | |
|      open(13,file=trim(temp_dir)//'/decoded.txt',status='unknown',            &
 | |
|           iostat=ios)
 | |
|   end if
 | |
|   if(ios.ne.0) then
 | |
|      nfail=nfail+1
 | |
|      if(nfail.le.3) then
 | |
|         call sleep_msec(10)
 | |
|         go to 10
 | |
|      endif
 | |
|   endif
 | |
| 
 | |
|   if(params%nmode.eq.8) then
 | |
| ! We're in FT8 mode
 | |
|      call timer('decft8  ',0)
 | |
|      newdat=params%newdat
 | |
|      call my_ft8%decode(ft8_decoded,id2,params%nQSOProgress,params%nfqso,    &
 | |
|           params%nftx,newdat,params%nutc,params%nfa,params%nfb,              &
 | |
|           params%nexp_decode,params%ndepth,logical(params%nagain),           &
 | |
|           logical(params%lapon),params%napwid,params%mycall,                 &
 | |
|           params%mygrid,params%hiscall,params%hisgrid)
 | |
|      call timer('decft8  ',1)
 | |
|      go to 800
 | |
|   endif
 | |
| 
 | |
|   rms=sqrt(dot_product(float(id2(300000:310000)),            &
 | |
|        float(id2(300000:310000)))/10000.0)
 | |
|   if(rms.lt.2.0) go to 800
 | |
| 
 | |
| ! Zap data at start that might come from T/R switching transient?
 | |
|   nadd=100
 | |
|   k=0
 | |
|   bad0=.false.
 | |
|   do i=1,240
 | |
|      sq=0.
 | |
|      do n=1,nadd
 | |
|         k=k+1
 | |
|         sq=sq + float(id2(k))**2
 | |
|      enddo
 | |
|      rms=sqrt(sq/nadd)
 | |
|      if(rms.gt.10000.0) then
 | |
|         bad0=.true.
 | |
|         kbad=k
 | |
|         rmsbad=rms
 | |
|      endif
 | |
|   enddo
 | |
|   if(bad0) then
 | |
|      nz=min(NTMAX*12000,kbad+100)
 | |
| !     id2(1:nz)=0                ! temporarily disabled as it can breaak the JT9 decoder, maybe others
 | |
|   endif
 | |
|   
 | |
|   if(params%nmode.eq.4 .or. params%nmode.eq.65) open(14,file=trim(temp_dir)// &
 | |
|        '/avemsg.txt',status='unknown')
 | |
|   if(params%nmode.eq.164) open(17,file=trim(temp_dir)//'/red.dat',          &
 | |
|        status='unknown')
 | |
| 
 | |
|   if(params%nmode.eq.4) then
 | |
|      jz=52*nfsample
 | |
|      if(params%newdat) then
 | |
|         if(nfsample.eq.12000) call wav11(id2,jz,dd)
 | |
|         if(nfsample.eq.11025) dd(1:jz)=id2(1:jz)
 | |
|      endif
 | |
|      call my_jt4%decode(jt4_decoded,dd,jz,params%nutc,params%nfqso,         &
 | |
|           params%ntol,params%emedelay,params%dttol,logical(params%nagain),  &
 | |
|           params%ndepth,logical(params%nclearave),params%minsync,           &
 | |
|           params%minw,params%nsubmode,params%mycall,params%hiscall,         &
 | |
|           params%hisgrid,params%nlist,params%listutc,jt4_average)
 | |
|      go to 800
 | |
|   endif
 | |
| 
 | |
|   npts65=52*12000
 | |
|   if(params%nmode.eq.164) npts65=54*12000
 | |
|   if(baddata(id2,npts65)) then
 | |
|      nsynced=0
 | |
|      ndecoded=0
 | |
|      go to 800
 | |
|   endif
 | |
|  
 | |
|   ntol65=params%ntol              !### is this OK? ###
 | |
|   newdat65=params%newdat
 | |
|   newdat9=params%newdat
 | |
| 
 | |
| !$call omp_set_dynamic(.true.)
 | |
| !$omp parallel sections num_threads(2) copyin(/timer_private/) shared(ndecoded) if(.true.) !iif() needed on Mac
 | |
| 
 | |
| !$omp section
 | |
|   if(params%nmode.eq.65 .or. params%nmode.eq.164 .or.                      &
 | |
|        (params%nmode.eq.(65+9) .and. params%ntxmode.eq.65)) then
 | |
| ! We're in JT65 or QRA64 mode, or should do JT65 first
 | |
| 
 | |
|      if(newdat65) dd(1:npts65)=id2(1:npts65)
 | |
|      nf1=params%nfa
 | |
|      nf2=params%nfb
 | |
|      call timer('jt65a   ',0)
 | |
|      call my_jt65%decode(jt65_decoded,dd,npts65,newdat65,params%nutc,      &
 | |
|           nf1,nf2,params%nfqso,ntol65,params%nsubmode,params%minsync,      &
 | |
|           logical(params%nagain),params%n2pass,logical(params%nrobust),    &
 | |
|           ntrials,params%naggressive,params%ndepth,params%emedelay,        &
 | |
|           logical(params%nclearave),params%mycall,params%hiscall,          &
 | |
|           params%hisgrid,params%nexp_decode)
 | |
|      call timer('jt65a   ',1)
 | |
| 
 | |
|   else if(params%nmode.eq.9 .or. (params%nmode.eq.(65+9) .and. params%ntxmode.eq.9)) then
 | |
| ! We're in JT9 mode, or should do JT9 first
 | |
|      call timer('decjt9  ',0)
 | |
|      call my_jt9%decode(jt9_decoded,ss,id2,params%nfqso,       &
 | |
|           newdat9,params%npts8,params%nfa,params%nfsplit,params%nfb,       &
 | |
|           params%ntol,params%nzhsym,logical(params%nagain),params%ndepth,  &
 | |
|           params%nmode,params%nsubmode,params%nexp_decode)
 | |
|      call timer('decjt9  ',1)
 | |
|   endif
 | |
| 
 | |
| !$omp section
 | |
|   if(params%nmode.eq.(65+9)) then       !Do the other mode (we're in dual mode)
 | |
|      if (params%ntxmode.eq.9) then
 | |
|         if(newdat65) dd(1:npts65)=id2(1:npts65)
 | |
|         nf1=params%nfa
 | |
|         nf2=params%nfb
 | |
|         call timer('jt65a   ',0)
 | |
|         call my_jt65%decode(jt65_decoded,dd,npts65,newdat65,params%nutc,   &
 | |
|              nf1,nf2,params%nfqso,ntol65,params%nsubmode,params%minsync,   &
 | |
|              logical(params%nagain),params%n2pass,logical(params%nrobust), &
 | |
|              ntrials,params%naggressive,params%ndepth,params%emedelay,     &
 | |
|              logical(params%nclearave),params%mycall,params%hiscall,       &
 | |
|              params%hisgrid,params%nexp_decode)
 | |
|         call timer('jt65a   ',1)
 | |
|      else
 | |
|         call timer('decjt9  ',0)
 | |
|         call my_jt9%decode(jt9_decoded,ss,id2,params%nfqso,                &
 | |
|              newdat9,params%npts8,params%nfa,params%nfsplit,params%nfb,    &
 | |
|              params%ntol,params%nzhsym,logical(params%nagain),             &
 | |
|              params%ndepth,params%nmode,params%nsubmode,params%nexp_decode)
 | |
|         call timer('decjt9  ',1)
 | |
|      end if
 | |
|   endif
 | |
| 
 | |
| !$omp end parallel sections
 | |
| 
 | |
| ! JT65 is not yet producing info for nsynced, ndecoded.
 | |
| 800 ndecoded = my_jt4%decoded + my_jt65%decoded + my_jt9%decoded + my_ft8%decoded
 | |
|   write(*,1010) nsynced,ndecoded
 | |
| 1010 format('<DecodeFinished>',2i4)
 | |
|   call flush(6)
 | |
|   close(13) 
 | |
|   if(params%nmode.eq.4 .or. params%nmode.eq.65) close(14)
 | |
| 
 | |
|   return
 | |
| 
 | |
| contains
 | |
| 
 | |
|   subroutine jt4_decoded(this,snr,dt,freq,have_sync,sync,is_deep,    &
 | |
|        decoded0,qual,ich,is_average,ave)
 | |
|     implicit none
 | |
|     class(jt4_decoder), intent(inout) :: this
 | |
|     integer, intent(in) :: snr
 | |
|     real, intent(in) :: dt
 | |
|     integer, intent(in) :: freq
 | |
|     logical, intent(in) :: have_sync
 | |
|     logical, intent(in) :: is_deep
 | |
|     character(len=1), intent(in) :: sync
 | |
|     character(len=22), intent(in) :: decoded0
 | |
|     real, intent(in) :: qual
 | |
|     integer, intent(in) :: ich
 | |
|     logical, intent(in) :: is_average
 | |
|     integer, intent(in) :: ave
 | |
| 
 | |
|     character*22 decoded
 | |
|     character*3 cflags
 | |
| 
 | |
|     if(ich.eq.-99) stop                         !Silence compiler warning
 | |
|     if (have_sync) then
 | |
|        decoded=decoded0
 | |
|        cflags='   '
 | |
|        if(decoded.ne.'                      ') cflags='f  '
 | |
|        if(is_deep) then
 | |
|           cflags(1:2)='d1'
 | |
|           write(cflags(3:3),'(i1)') min(int(qual),9)
 | |
|           if(qual.ge.10.0) cflags(3:3)='*'
 | |
|           if(qual.lt.3.0) decoded(22:22)='?'
 | |
|        endif
 | |
|        if(is_average) then
 | |
|           write(cflags(2:2),'(i1)') min(ave,9)
 | |
|           if(ave.ge.10) cflags(2:2)='*'
 | |
|        endif
 | |
|        write(*,1000) params%nutc,snr,dt,freq,sync,decoded,cflags
 | |
| 1000   format(i4.4,i4,f5.1,i5,1x,'$',a1,1x,a22,1x,a3)
 | |
|     else
 | |
|        write(*,1000) params%nutc,snr,dt,freq
 | |
|     end if
 | |
| 
 | |
|     select type(this)
 | |
|     type is (counting_jt4_decoder)
 | |
|        this%decoded = this%decoded + 1
 | |
|     end select
 | |
|   end subroutine jt4_decoded
 | |
| 
 | |
|   subroutine jt4_average (this, used, utc, sync, dt, freq, flip)
 | |
|     implicit none
 | |
|     class(jt4_decoder), intent(inout) :: this
 | |
|     logical, intent(in) :: used
 | |
|     integer, intent(in) :: utc
 | |
|     real, intent(in) :: sync
 | |
|     real, intent(in) :: dt
 | |
|     integer, intent(in) :: freq
 | |
|     logical, intent(in) :: flip
 | |
|     character(len=1) :: cused, csync
 | |
| 
 | |
|     cused = '.'
 | |
|     csync = '*'
 | |
|     if (used) cused = '$'
 | |
|     if (flip) csync = '$'
 | |
|     write(14,1000) cused,utc,sync,dt,freq,csync
 | |
| 1000 format(a1,i5.4,f6.1,f6.2,i6,1x,a1)
 | |
|   end subroutine jt4_average
 | |
| 
 | |
|   subroutine jt65_decoded(this,sync,snr,dt,freq,drift,nflip,width,     &
 | |
|        decoded0,ft,qual,nsmo,nsum,minsync)
 | |
| 
 | |
|     use jt65_decode
 | |
|     implicit none
 | |
| 
 | |
|     class(jt65_decoder), intent(inout) :: this
 | |
|     real, intent(in) :: sync
 | |
|     integer, intent(in) :: snr
 | |
|     real, intent(in) :: dt
 | |
|     integer, intent(in) :: freq
 | |
|     integer, intent(in) :: drift
 | |
|     integer, intent(in) :: nflip
 | |
|     real, intent(in) :: width
 | |
|     character(len=22), intent(in) :: decoded0
 | |
|     integer, intent(in) :: ft
 | |
|     integer, intent(in) :: qual
 | |
|     integer, intent(in) :: nsmo
 | |
|     integer, intent(in) :: nsum
 | |
|     integer, intent(in) :: minsync
 | |
| 
 | |
|     integer i,nft
 | |
|     logical is_deep,is_average
 | |
|     character decoded*22,csync*2,cflags*3
 | |
| 
 | |
|     if(width.eq.-9999.0) stop              !Silence compiler warning
 | |
| !$omp critical(decode_results)
 | |
|     decoded=decoded0
 | |
|     cflags='   '
 | |
|     is_deep=ft.eq.2
 | |
| 
 | |
|     if(ft.ge.80) then                      !QRA64 mode
 | |
|        nft=ft-100
 | |
|        csync=': '
 | |
|        if(sync-3.4.ge.float(minsync) .or. nft.ge.0) csync=':*'
 | |
|        if(nft.lt.0) then
 | |
|           write(*,1009) params%nutc,snr,dt,freq,csync,decoded
 | |
|        else
 | |
|           write(*,1009) params%nutc,snr,dt,freq,csync,decoded,nft
 | |
| 1009      format(i4.4,i4,f5.1,i5,1x,a2,1x,a22,i2)
 | |
|        endif
 | |
|        write(13,1011) params%nutc,nint(sync),snr,dt,float(freq),drift,    &
 | |
|             decoded,nft
 | |
| 1011   format(i4.4,i4,i5,f6.2,f8.0,i4,3x,a22,' QRA64',i3)
 | |
|        go to 100
 | |
|     endif
 | |
|     
 | |
|     if(ft.eq.0 .and. minsync.ge.0 .and. int(sync).lt.minsync) then
 | |
|        write(*,1010) params%nutc,snr,dt,freq
 | |
|     else
 | |
|        is_average=nsum.ge.2
 | |
|        if(bVHF .and. ft.gt.0) then
 | |
|           cflags='f  '
 | |
|           if(is_deep) then
 | |
|              cflags(1:2)='d1'
 | |
|              write(cflags(3:3),'(i1)') min(qual,9)
 | |
|              if(qual.ge.10) cflags(3:3)='*'
 | |
|              if(qual.lt.3) decoded(22:22)='?'
 | |
|           endif
 | |
|           if(is_average) then
 | |
|              write(cflags(2:2),'(i1)') min(nsum,9)
 | |
|              if(nsum.ge.10) cflags(2:2)='*'
 | |
|           endif
 | |
|        endif
 | |
|        csync='# '
 | |
|        i=0
 | |
|        if(bVHF .and. nflip.ne.0 .and.                         &
 | |
|             sync.ge.max(0.0,float(minsync))) then
 | |
|           csync='#*'
 | |
|           if(nflip.eq.-1) then
 | |
|              csync='##'
 | |
|              if(decoded.ne.'                      ') then
 | |
|                 do i=22,1,-1
 | |
|                    if(decoded(i:i).ne.' ') exit
 | |
|                 enddo
 | |
|                 if(i.gt.18) i=18
 | |
|                 decoded(i+2:i+4)='OOO'
 | |
|              endif
 | |
|           endif
 | |
|        endif
 | |
|        write(*,1010) params%nutc,snr,dt,freq,csync,decoded,cflags
 | |
| 1010   format(i4.4,i4,f5.1,i5,1x,a2,1x,a22,1x,a3)
 | |
|     endif
 | |
|     write(13,1012) params%nutc,nint(sync),snr,dt,float(freq),drift,    &
 | |
|          decoded,ft,nsum,nsmo
 | |
| 1012 format(i4.4,i4,i5,f6.2,f8.0,i4,3x,a22,' JT65',3i3)
 | |
| 
 | |
| 100 call flush(6)
 | |
| 
 | |
| !$omp end critical(decode_results)
 | |
|     select type(this)
 | |
|     type is (counting_jt65_decoder)
 | |
|        this%decoded = this%decoded + 1
 | |
|     end select
 | |
|   end subroutine jt65_decoded
 | |
| 
 | |
|   subroutine jt9_decoded (this, sync, snr, dt, freq, drift, decoded)
 | |
|     use jt9_decode
 | |
|     implicit none
 | |
| 
 | |
|     class(jt9_decoder), intent(inout) :: this
 | |
|     real, intent(in) :: sync
 | |
|     integer, intent(in) :: snr
 | |
|     real, intent(in) :: dt
 | |
|     real, intent(in) :: freq
 | |
|     integer, intent(in) :: drift
 | |
|     character(len=22), intent(in) :: decoded
 | |
| 
 | |
|     !$omp critical(decode_results)
 | |
|     write(*,1000) params%nutc,snr,dt,nint(freq),decoded
 | |
| 1000 format(i4.4,i4,f5.1,i5,1x,'@ ',1x,a22)
 | |
|     write(13,1002) params%nutc,nint(sync),snr,dt,freq,drift,decoded
 | |
| 1002 format(i4.4,i4,i5,f6.1,f8.0,i4,3x,a22,' JT9')
 | |
|     call flush(6)
 | |
|     !$omp end critical(decode_results)
 | |
|     select type(this)
 | |
|     type is (counting_jt9_decoder)
 | |
|        this%decoded = this%decoded + 1
 | |
|     end select
 | |
|   end subroutine jt9_decoded
 | |
| 
 | |
|   subroutine ft8_decoded (this,sync,snr,dt,freq,decoded,nap,qual)
 | |
|     use ft8_decode
 | |
|     implicit none
 | |
| 
 | |
|     class(ft8_decoder), intent(inout) :: this
 | |
|     real, intent(in) :: sync
 | |
|     integer, intent(in) :: snr
 | |
|     real, intent(in) :: dt
 | |
|     real, intent(in) :: freq
 | |
|     character(len=22), intent(in) :: decoded
 | |
|     integer, intent(in) :: nap 
 | |
|     real, intent(in) :: qual 
 | |
|     character*2 annot
 | |
|     character*22 decoded0
 | |
|   
 | |
|     decoded0=decoded 
 | |
|     annot='  ' 
 | |
|     if(nap.ne.0) then
 | |
|       write(annot,'(a1,i1)') 'a',nap
 | |
|       if(qual.lt.0.17) decoded0(22:22)='?'
 | |
|     endif
 | |
|     write(*,1000) params%nutc,snr,dt,nint(freq),decoded0,annot
 | |
| 1000 format(i6.6,i4,f5.1,i5,' ~ ',1x,a22,1x,a2)
 | |
|     write(13,1002) params%nutc,nint(sync),snr,dt,freq,0,decoded0
 | |
| 1002 format(i6.6,i4,i5,f6.1,f8.0,i4,3x,a22,' FT8')
 | |
|     call flush(6)
 | |
|     call flush(13)
 | |
|     
 | |
|     select type(this)
 | |
|     type is (counting_ft8_decoder)
 | |
|        this%decoded = this%decoded + 1
 | |
|     end select
 | |
| 
 | |
|     return
 | |
|   end subroutine ft8_decoded
 | |
| 
 | |
| end subroutine multimode_decoder
 | 
