subroutine multimode_decoder(ss,id2,params,nfsample) !$ use omp_lib use prog_args use timer_module, only: timer use ft8_decode use js8b_decode use js8c_decode use js8d_decode include 'jt9com.f90' include 'timer_common.inc' type, extends(ft8_decoder) :: counting_ft8_decoder integer :: decoded end type counting_ft8_decoder type, extends(js8b_decoder) :: counting_js8b_decoder integer :: decoded end type counting_js8b_decoder type, extends(js8c_decoder) :: counting_js8c_decoder integer :: decoded end type counting_js8c_decoder type, extends(js8d_decoder) :: counting_js8d_decoder integer :: decoded end type counting_js8d_decoder real ss(184,NSMAX) logical baddata,newdat65,newdat9,single_decode,bVHF,bad0,newdat,trydecode integer*2 id0(NTMAX*12000) integer*2 id2(NTMAX*12000) type(params_block) :: params character(len=20) :: datetime character(len=12) :: mycall, hiscall character(len=6) :: mygrid, hisgrid save type(counting_ft8_decoder) :: my_js8a type(counting_js8b_decoder) :: my_js8b type(counting_js8c_decoder) :: my_js8c type(counting_js8d_decoder) :: my_js8d !cast C character arrays to Fortran character strings datetime=transfer(params%datetime, datetime) mycall=transfer(params%mycall,mycall) hiscall=transfer(params%hiscall,hiscall) mygrid=transfer(params%mygrid,mygrid) hisgrid=transfer(params%hisgrid,hisgrid) ! initialize decode counts my_js8a%decoded = 0 my_js8b%decoded = 0 my_js8c%decoded = 0 my_js8d%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 10 nfail=0 if(params%nmode.eq.8) then c2fox=' ' g2fox=' ' nsnrfox=-99 nfreqfox=-99 n30z=0 nwrap=0 nfox=0 endif if(ios.ne.0) then nfail=nfail+1 if(nfail.le.3) then call sleep_msec(10) go to 10 endif endif trydecode=.false. if(params%nmode.eq.8 .and. (params%nsubmode.eq.4 .or. iand(params%nsubmodes, 8).eq.8)) then ! We're in JS8 mode D call timer('decjs8d ',0) newdat=params%newdat trydecode=.true. ! copy the relevant frames for decoding pos = params%kposD sz = params%kszD id0=0 id0(1:sz+1)=id2(pos+1:pos+sz+1) call my_js8d%decode(js8d_decoded,id0,params%nQSOProgress,params%nfqso, & params%nftx,newdat,params%nutc,params%nfa,params%nfb, & params%nexp_decode,params%ndepth,logical(params%nagain), & logical(params%lft8apon),logical(params%lapcqonly),params%napwid, & mycall,mygrid,hiscall,hisgrid) call timer('decjs8d ',1) endif if(params%nmode.eq.8 .and. (params%nsubmode.eq.2 .or. iand(params%nsubmodes, 4).eq.4)) then ! We're in JS8 mode C call timer('decjs8c ',0) newdat=params%newdat trydecode=.true. ! copy the relevant frames for decoding pos = params%kposC sz = params%kszC id0=0 id0(1:sz+1)=id2(pos+1:pos+sz+1) call my_js8c%decode(js8c_decoded,id0,params%nQSOProgress,params%nfqso, & params%nftx,newdat,params%nutc,params%nfa,params%nfb, & params%nexp_decode,params%ndepth,logical(params%nagain), & logical(params%lft8apon),logical(params%lapcqonly),params%napwid, & mycall,mygrid,hiscall,hisgrid) call timer('decjs8c ',1) endif if(params%nmode.eq.8 .and. (params%nsubmode.eq.1 .or. iand(params%nsubmodes, 2).eq.2)) then ! We're in JS8 mode B call timer('decjs8b ',0) newdat=params%newdat trydecode=.true. ! copy the relevant frames for decoding pos = params%kposB sz = params%kszB id0=0 id0(1:sz+1)=id2(pos+1:pos+sz+1) call my_js8b%decode(js8b_decoded,id0,params%nQSOProgress,params%nfqso, & params%nftx,newdat,params%nutc,params%nfa,params%nfb, & params%nexp_decode,params%ndepth,logical(params%nagain), & logical(params%lft8apon),logical(params%lapcqonly),params%napwid, & mycall,mygrid,hiscall,hisgrid) call timer('decjs8b ',1) endif if(params%nmode.eq.8 .and. (params%nsubmode.eq.0 .or. iand(params%nsubmodes, 1).eq.1)) then ! We're in JS8 mode A call timer('decjs8a ',0) newdat=params%newdat trydecode=.true. ! copy the relevant frames for decoding pos = params%kposA sz = params%kszA id0=0 id0(1:sz+1)=id2(pos+1:pos+sz+1) call my_js8a%decode(js8a_decoded,id0,params%nQSOProgress,params%nfqso, & params%nftx,newdat,params%nutc,params%nfa,params%nfb, & params%nexp_decode,params%ndepth,logical(params%nagain), & logical(params%lft8apon),logical(params%lapcqonly),params%napwid, & mycall,mygrid,hiscall,hisgrid) call timer('decjs8a ',1) endif if(trydecode) go to 800 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 npts65=52*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.) 800 ndecoded = my_js8a%decoded + my_js8b%decoded + my_js8c%decoded + my_js8d%decoded write(*,1010) nsynced,ndecoded 1010 format('',2i4) call flush(6) return contains subroutine js8_decoded (sync,snr,dt,freq,decoded,nap,qual,submode) implicit none real, intent(in) :: sync integer, intent(in) :: snr real, intent(in) :: dt real, intent(in) :: freq character(len=37), intent(in) :: decoded character c1*12,c2*12,g2*4,w*4 integer i0,i1,i2,i3,i4,i5,n30,nwrap integer, intent(in) :: nap real, intent(in) :: qual integer, intent(in) :: submode character*3 m character*2 annot character*37 decoded0 logical isgrid4,first,b0,b1,b2 data first/.true./ save isgrid4(w)=(len_trim(w).eq.4 .and. & ichar(w(1:1)).ge.ichar('A') .and. ichar(w(1:1)).le.ichar('R') .and. & ichar(w(2:2)).ge.ichar('A') .and. ichar(w(2:2)).le.ichar('R') .and. & ichar(w(3:3)).ge.ichar('0') .and. ichar(w(3:3)).le.ichar('9') .and. & ichar(w(4:4)).ge.ichar('0') .and. ichar(w(4:4)).le.ichar('9')) if(first) then c2fox=' ' g2fox=' ' nsnrfox=-99 nfreqfox=-99 n30z=0 nwrap=0 nfox=0 first=.false. endif decoded0=decoded annot=' ' if(nap.ne.0) then write(annot,'(a1,i1)') 'a',nap if(qual.lt.0.17) decoded0(22:22)='?' endif m = ' ~ ' if(submode.eq.0) m=' A ' if(submode.eq.1) m=' B ' if(submode.eq.2) m=' C ' if(submode.eq.3) m=' D ' i0=index(decoded0,';') if(i0.le.0) write(*,1000) params%nutc,snr,dt,nint(freq),m,decoded0(1:22),annot 1000 format(i6.6,i4,f5.1,i5,a3,1x,a22,1x,a2) if(i0.gt.0) write(*,1001) params%nutc,snr,dt,nint(freq),m,decoded0 1001 format(i6.6,i4,f5.1,i5,a3,1x,a37) i1=index(decoded0,' ') i2=i1 + index(decoded0(i1+1:),' ') i3=i2 + index(decoded0(i2+1:),' ') if(i1.ge.3 .and. i2.ge.7 .and. i3.ge.10) then c1=decoded0(1:i1-1)//' ' c2=decoded0(i1+1:i2-1) g2=decoded0(i2+1:i3-1) b0=c1.eq.mycall if(c1(1:3).eq.'DE ' .and. index(c2,'/').ge.2) b0=.true. if(len(trim(c1)).ne.len(trim(mycall))) then i4=index(trim(c1),trim(mycall)) i5=index(trim(mycall),trim(c1)) if(i4.ge.1 .or. i5.ge.1) b0=.true. endif b1=i3-i2.eq.5 .and. isgrid4(g2) b2=i3-i2.eq.1 if(b0 .and. (b1.or.b2) .and. nint(freq).ge.1000) then n=params%nutc n30=(3600*(n/10000) + 60*mod((n/100),100) + mod(n,100))/30 if(n30.lt.n30z) nwrap=nwrap+5760 !New UTC day, handle the wrap n30z=n30 n30=n30+nwrap nfox=nfox+1 c2fox(nfox)=c2 g2fox(nfox)=g2 nsnrfox(nfox)=snr nfreqfox(nfox)=nint(freq) n30fox(nfox)=n30 endif endif call flush(6) return end subroutine js8_decoded subroutine js8a_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=37), intent(in) :: decoded integer, intent(in) :: nap real, intent(in) :: qual save call js8_decoded(sync, snr, dt, freq, decoded, nap, qual, 0) select type(this) type is (counting_ft8_decoder) this%decoded = this%decoded + 1 end select return end subroutine js8a_decoded subroutine js8b_decoded (this,sync,snr,dt,freq,decoded,nap,qual) use js8b_decode implicit none class(js8b_decoder), intent(inout) :: this real, intent(in) :: sync integer, intent(in) :: snr real, intent(in) :: dt real, intent(in) :: freq character(len=37), intent(in) :: decoded integer, intent(in) :: nap real, intent(in) :: qual save call js8_decoded(sync, snr, dt, freq, decoded, nap, qual, 1) select type(this) type is (counting_js8b_decoder) this%decoded = this%decoded + 1 end select return end subroutine js8b_decoded subroutine js8c_decoded (this,sync,snr,dt,freq,decoded,nap,qual) use js8c_decode implicit none class(js8c_decoder), intent(inout) :: this real, intent(in) :: sync integer, intent(in) :: snr real, intent(in) :: dt real, intent(in) :: freq character(len=37), intent(in) :: decoded integer, intent(in) :: nap real, intent(in) :: qual save call js8_decoded(sync, snr, dt, freq, decoded, nap, qual, 2) select type(this) type is (counting_js8c_decoder) this%decoded = this%decoded + 1 end select return end subroutine js8c_decoded subroutine js8d_decoded (this,sync,snr,dt,freq,decoded,nap,qual) use js8d_decode implicit none class(js8d_decoder), intent(inout) :: this real, intent(in) :: sync integer, intent(in) :: snr real, intent(in) :: dt real, intent(in) :: freq character(len=37), intent(in) :: decoded integer, intent(in) :: nap real, intent(in) :: qual save call js8_decoded(sync, snr, dt, freq, decoded, nap, qual, 3) select type(this) type is (counting_js8d_decoder) this%decoded = this%decoded + 1 end select return end subroutine js8d_decoded end subroutine multimode_decoder