subroutine multimode_decoder(ss,id2,params,nfsample) !$ use omp_lib use prog_args use timer_module, only: timer use js8a_decode use js8b_decode use js8c_decode use js8e_decode use js8i_decode include 'jt9com.f90' include 'timer_common.inc' type, extends(js8a_decoder) :: counting_js8a_decoder integer :: decoded end type counting_js8a_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(js8e_decoder) :: counting_js8e_decoder integer :: decoded end type counting_js8e_decoder type, extends(js8i_decoder) :: counting_js8i_decoder integer :: decoded end type counting_js8i_decoder real ss(184,NSMAX) logical baddata,newdat65,newdat9,single_decode,bVHF,bad0,newdat,trydecode integer pos, sz 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_js8a_decoder) :: my_js8a type(counting_js8b_decoder) :: my_js8b type(counting_js8c_decoder) :: my_js8c type(counting_js8e_decoder) :: my_js8e type(counting_js8i_decoder) :: my_js8i !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_js8e%decoded = 0 my_js8i%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 if(params%nmode.eq.8) then n30z=0 nwrap=0 nfox=0 endif write(*,1012) params%nsubmode, params%nsubmodes 1012 format('',2i4) if(params%nmode.eq.8 .and. (params%nsubmode.eq.8 .or. iand(params%nsubmodes, 16).eq.16)) then ! We're in JS8 mode I call timer('decjs8i ',0) newdat=params%newdat write(*,*) ' mode I decode started' ! copy the relevant frames for decoding pos = max(0,params%kposI) sz = max(0,params%kszI) id0=0 id0(1:sz+1)=id2(pos+1:pos+sz+1) call my_js8i%decode(js8i_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) write(*,*) ' mode I decode finished' call timer('decjs8i ',1) endif if(params%nmode.eq.8 .and. (params%nsubmode.eq.4 .or. iand(params%nsubmodes, 8).eq.8)) then ! We're in JS8 mode E call timer('decjs8e ',0) newdat=params%newdat write(*,*) ' mode E decode started' ! copy the relevant frames for decoding pos = max(0,params%kposE) sz = max(0,params%kszE) id0=0 id0(1:sz+1)=id2(pos+1:pos+sz+1) call my_js8e%decode(js8e_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) write(*,*) ' mode E decode finished' call timer('decjs8e ',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 write(*,*) ' mode C decode started' ! copy the relevant frames for decoding pos = max(0,params%kposC) sz = max(0,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) write(*,*) ' mode C decode finished' 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 write(*,*) ' mode B decode started' ! copy the relevant frames for decoding pos = max(0,params%kposB) sz = max(0,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) write(*,*) ' mode B decode finished' 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 write(*,*) ' mode A decode started' ! copy the relevant frames for decoding pos = max(0,params%kposA) sz = max(0,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) write(*,*) ' mode A decode finished' call timer('decjs8a ',1) endif write(*,*) ' finished' call flush(6) ndecoded = my_js8a%decoded + my_js8b%decoded + my_js8c%decoded + my_js8e%decoded !call sleep_msec(3000) write(*,1010) ndecoded 1010 format('',i4) 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,n 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 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.4) m=' E ' if(submode.eq.8) m=' I ' 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 endif endif call flush(6) return end subroutine js8_decoded subroutine js8a_decoded (this,sync,snr,dt,freq,decoded,nap,qual) use js8a_decode implicit none class(js8a_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 integer :: submode save submode=0 call js8_decoded(sync, snr, dt, freq, decoded, nap, qual, submode) select type(this) type is (counting_js8a_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 integer :: submode save submode=1 call js8_decoded(sync, snr, dt, freq, decoded, nap, qual, submode) 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 integer :: submode save submode=2 call js8_decoded(sync, snr, dt, freq, decoded, nap, qual, submode) select type(this) type is (counting_js8c_decoder) this%decoded = this%decoded + 1 end select return end subroutine js8c_decoded subroutine js8e_decoded (this,sync,snr,dt,freq,decoded,nap,qual) use js8e_decode implicit none class(js8e_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 integer :: submode save submode=4 call js8_decoded(sync, snr, dt, freq, decoded, nap, qual, submode) select type(this) type is (counting_js8e_decoder) this%decoded = this%decoded + 1 end select return end subroutine js8e_decoded subroutine js8i_decoded (this,sync,snr,dt,freq,decoded,nap,qual) use js8i_decode implicit none class(js8i_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 integer :: submode save submode=8 call js8_decoded(sync, snr, dt, freq, decoded, nap, qual, submode) select type(this) type is (counting_js8i_decoder) this%decoded = this%decoded + 1 end select return end subroutine js8i_decoded end subroutine multimode_decoder