mirror of
				https://github.com/saitohirga/WSJT-X.git
				synced 2025-11-03 21:40:52 -05:00 
			
		
		
		
	Some tweaks to qra64a.f90. More to come!
git-svn-id: svn+ssh://svn.code.sf.net/p/wsjt/wsjt/branches/wsjtx@7367 ab8295b8-cf94-4d9e-aec4-7959e3be5d79
This commit is contained in:
		
							parent
							
								
									8f436bdb78
								
							
						
					
					
						commit
						bc068209dc
					
				
							
								
								
									
										144
									
								
								lib/qra64a.f90
									
									
									
									
									
								
							
							
						
						
									
										144
									
								
								lib/qra64a.f90
									
									
									
									
									
								
							@ -23,9 +23,9 @@ subroutine qra64a(dd,npts,nutc,nf1,nf2,nfqso,ntol,mode64,minsync,ndepth,   &
 | 
				
			|||||||
  data nc1z/-1/,nc2z/-1/,ng2z/-1/,maxaptypez/-1/
 | 
					  data nc1z/-1/,nc2z/-1/,ng2z/-1/,maxaptypez/-1/
 | 
				
			||||||
  save
 | 
					  save
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					  if(nfqso.lt.nf1 .or. nfqso.gt.nf2) go to 900
 | 
				
			||||||
  call timer('qra64a  ',0)
 | 
					  call timer('qra64a  ',0)
 | 
				
			||||||
  decoded='                      '
 | 
					  decoded='                      '
 | 
				
			||||||
  if(nfqso.lt.nf1 .or. nfqso.gt.nf2) go to 900
 | 
					 | 
				
			||||||
  nft=99
 | 
					  nft=99
 | 
				
			||||||
  nsnr=-30
 | 
					  nsnr=-30
 | 
				
			||||||
  mycall=mycall_12(1:6)                     !### May need fixing ###
 | 
					  mycall=mycall_12(1:6)                     !### May need fixing ###
 | 
				
			||||||
@ -59,15 +59,10 @@ subroutine qra64a(dd,npts,nutc,nf1,nf2,nfqso,ntol,mode64,minsync,ndepth,   &
 | 
				
			|||||||
 | 
					
 | 
				
			||||||
  maxf1=0
 | 
					  maxf1=0
 | 
				
			||||||
  call timer('sync64  ',0)
 | 
					  call timer('sync64  ',0)
 | 
				
			||||||
  call sync64(dd,npts,nf1,nf2,nfqso,ntol,mode64,maxf1,dtx,f0,jpk,kpk,sync,c00)
 | 
					  call sync64(dd,npts,nf1,nf2,nfqso,ntol,mode64,maxf1,dtx,f0,jpk0,kpk,sync,c00)
 | 
				
			||||||
  call timer('sync64  ',1)
 | 
					  call timer('sync64  ',1)
 | 
				
			||||||
  irc=-99
 | 
					  irc=-99
 | 
				
			||||||
  
 | 
					  s3lim=20.
 | 
				
			||||||
!  sync=5
 | 
					 | 
				
			||||||
!  dtx=0.
 | 
					 | 
				
			||||||
!  f0=1000.
 | 
					 | 
				
			||||||
  
 | 
					 | 
				
			||||||
!  if(sync.lt.minsync+3.5) go to 900
 | 
					 | 
				
			||||||
  
 | 
					  
 | 
				
			||||||
  npts2=npts/2
 | 
					  npts2=npts/2
 | 
				
			||||||
  itz=11
 | 
					  itz=11
 | 
				
			||||||
@ -77,77 +72,74 @@ subroutine qra64a(dd,npts,nutc,nf1,nf2,nfqso,ntol,mode64,minsync,ndepth,   &
 | 
				
			|||||||
  
 | 
					  
 | 
				
			||||||
  LL=64*(mode64+2)
 | 
					  LL=64*(mode64+2)
 | 
				
			||||||
  NN=63
 | 
					  NN=63
 | 
				
			||||||
!  do itry0=1,3
 | 
					  napmin=99
 | 
				
			||||||
  do itry0=1,1
 | 
					  do itry0=1,7
 | 
				
			||||||
     idf0=itry0/2
 | 
					     idt=itry0/2
 | 
				
			||||||
     if(mod(itry0,2).eq.0) idf0=-idf0
 | 
					     if(mod(itry0,2).eq.0) idt=-idt
 | 
				
			||||||
     a(1)=-(f0+0.248*(idf0-0.33*kpk))
 | 
					     jpk=jpk0 + 1500*idt
 | 
				
			||||||
     nfreq=nint(-a(1))
 | 
					     a=0.
 | 
				
			||||||
     a(3)=0.
 | 
					     a(1)=-f0
 | 
				
			||||||
!     do itry1=1,3
 | 
					     nfreq=nint(f0)
 | 
				
			||||||
     do itry1=1,1
 | 
					     call twkfreq(c00,c0,npts2,6000.0,a)
 | 
				
			||||||
        idf1=itry1/2
 | 
					     call spec64(c0,npts2,mode64,jpk,s3a,LL,NN)
 | 
				
			||||||
        if(mod(itry1,2).eq.0) idf1=-idf1
 | 
					     call pctile(s3a,LL*NN,45,base)
 | 
				
			||||||
        a(2)=-0.67*(idf1 + 0.67*kpk)
 | 
					     s3a=s3a/base
 | 
				
			||||||
        call twkfreq(c00,c0,npts2,6000.0,a)
 | 
					     where(s3a(1:LL*NN)>s3lim) s3a(1:LL*NN)=s3lim
 | 
				
			||||||
        call spec64(c0,npts2,mode64,jpk,s3a,LL,NN)
 | 
					     do iter=itz,0,-2
 | 
				
			||||||
 | 
					        b90=1.728**iter
 | 
				
			||||||
!### Parameters 3000.0 and 10.0 might be better optimized?
 | 
					        if(b90.gt.230.0) cycle
 | 
				
			||||||
        call pctile(s3a,LL*NN,45,base)
 | 
					        s3(1:LL*NN)=s3a(1:LL*NN)
 | 
				
			||||||
        s3max=3000.0
 | 
					        call timer('qra64_de',0)
 | 
				
			||||||
        if(sync.gt.5.0) s3max=15000.0/sync
 | 
					        call qra64_dec(s3,nc1,nc2,ng2,naptype,0,nSubmode,b90,      &
 | 
				
			||||||
        s3max=max(10.0,s3max)
 | 
					             nFadingModel,dat4,snr2,irc)
 | 
				
			||||||
        do i=1,LL*NN
 | 
					        call timer('qra64_de',1)
 | 
				
			||||||
           if(s3a(i).gt.s3max*base) s3a(i)=s3max*base
 | 
					        if(abs(snr2).gt.30.) snr2=-30.0
 | 
				
			||||||
        enddo
 | 
					        if(irc.eq.0) go to 10
 | 
				
			||||||
        s3pk=maxval(s3a(1:LL*NN))
 | 
					        if(irc.gt.0) call badmsg(irc,dat4,nc1,nc2,ng2)
 | 
				
			||||||
        
 | 
					        iirc=max(0,min(irc,11))
 | 
				
			||||||
        napmin=99
 | 
					        if(irc.gt.0 .and. nap(iirc).lt.napmin) then
 | 
				
			||||||
        do iter=itz,0,-2
 | 
					           dat4x=dat4
 | 
				
			||||||
           b90=1.728**iter
 | 
					           b90x=b90
 | 
				
			||||||
           if(b90.gt.230.0) cycle
 | 
					           snr2x=snr2
 | 
				
			||||||
           s3(1:LL*NN)=s3a(1:LL*NN)
 | 
					           napmin=nap(iirc)
 | 
				
			||||||
           call timer('qra64_de',0)
 | 
					           irckeep=irc
 | 
				
			||||||
           call qra64_dec(s3,nc1,nc2,ng2,naptype,0,nSubmode,b90,      &
 | 
					           dtxkeep=jpk/6000.0 - 1.0
 | 
				
			||||||
                nFadingModel,dat4,snr2,irc)
 | 
					           itry0keep=itry0
 | 
				
			||||||
           call timer('qra64_de',1)
 | 
					           iterkeep=iter
 | 
				
			||||||
           if(abs(snr2).gt.30.) snr2=-30.0
 | 
					 | 
				
			||||||
           if(irc.eq.0) go to 10
 | 
					 | 
				
			||||||
           if(irc.gt.0) call badmsg(irc,dat4,nc1,nc2,ng2)
 | 
					 | 
				
			||||||
           if(irc.lt.0) cycle
 | 
					 | 
				
			||||||
           iirc=max(0,min(irc,11))
 | 
					 | 
				
			||||||
           if(irc.gt.0 .and. nap(iirc).le.napmin) then
 | 
					 | 
				
			||||||
              dat4x=dat4
 | 
					 | 
				
			||||||
              b90x=b90
 | 
					 | 
				
			||||||
              snr2x=snr2
 | 
					 | 
				
			||||||
              napmin=nap(iirc)
 | 
					 | 
				
			||||||
              irckeep=irc
 | 
					 | 
				
			||||||
           endif
 | 
					 | 
				
			||||||
        enddo
 | 
					 | 
				
			||||||
        if(napmin.ne.99) then
 | 
					 | 
				
			||||||
              dat4=dat4x
 | 
					 | 
				
			||||||
              b90=b90x
 | 
					 | 
				
			||||||
              snr2=snr2x
 | 
					 | 
				
			||||||
              irc=irckeep
 | 
					 | 
				
			||||||
        endif
 | 
					 | 
				
			||||||
10      decoded='                      '
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
        if(irc.ge.0) then
 | 
					 | 
				
			||||||
           call unpackmsg(dat4,decoded)           !Unpack the user message
 | 
					 | 
				
			||||||
           call fmtmsg(decoded,iz)
 | 
					 | 
				
			||||||
           nft=100 + irc
 | 
					 | 
				
			||||||
           nsnr=nint(snr2)
 | 
					 | 
				
			||||||
        else
 | 
					 | 
				
			||||||
           snr2=0.
 | 
					 | 
				
			||||||
        endif
 | 
					        endif
 | 
				
			||||||
     enddo
 | 
					     enddo
 | 
				
			||||||
 | 
					     if(irc.eq.0) exit
 | 
				
			||||||
  enddo
 | 
					  enddo
 | 
				
			||||||
900 continue
 | 
					
 | 
				
			||||||
  if(index(decoded,"000AAA ").ge.1) then
 | 
					  if(napmin.ne.99) then
 | 
				
			||||||
! Suppress a certain type of garbage decode.
 | 
					     dat4=dat4x
 | 
				
			||||||
     decoded='                      '
 | 
					     b90=b90x
 | 
				
			||||||
     irc=-1
 | 
					     snr2=snr2x
 | 
				
			||||||
 | 
					     irc=irckeep
 | 
				
			||||||
 | 
					     dtx=dtxkeep
 | 
				
			||||||
 | 
					     itry0=itry0keep
 | 
				
			||||||
 | 
					     iter=iterkeep
 | 
				
			||||||
  endif
 | 
					  endif
 | 
				
			||||||
 | 
					10 decoded='                      '
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					  if(irc.ge.0) then
 | 
				
			||||||
 | 
					     call unpackmsg(dat4,decoded)           !Unpack the user message
 | 
				
			||||||
 | 
					     call fmtmsg(decoded,iz)
 | 
				
			||||||
 | 
					     if(index(decoded,"000AAA ").ge.1) then
 | 
				
			||||||
 | 
					        ! Suppress a certain type of garbage decode.
 | 
				
			||||||
 | 
					        decoded='                      '
 | 
				
			||||||
 | 
					        irc=-1
 | 
				
			||||||
 | 
					     endif
 | 
				
			||||||
 | 
					     nft=100 + irc
 | 
				
			||||||
 | 
					     nsnr=nint(snr2)
 | 
				
			||||||
 | 
					  else
 | 
				
			||||||
 | 
					     snr2=0.
 | 
				
			||||||
 | 
					  endif
 | 
				
			||||||
 | 
					  
 | 
				
			||||||
 | 
					  write(60,3100) nutc,nsnr,dtx,f0,sync,itry0,iter,irc,decoded
 | 
				
			||||||
 | 
					3100 format(i4.4,i4,f6.2,2f7.1,3i4,2x,a22)
 | 
				
			||||||
 | 
					  flush(60)
 | 
				
			||||||
 | 
					  
 | 
				
			||||||
  if(irc.lt.0) then
 | 
					  if(irc.lt.0) then
 | 
				
			||||||
     sy=max(1.0,sync-2.5)
 | 
					     sy=max(1.0,sync-2.5)
 | 
				
			||||||
     if(nSubmode.eq.0) nsnr=nint(10.0*log10(sy)-38.0)   !A
 | 
					     if(nSubmode.eq.0) nsnr=nint(10.0*log10(sy)-38.0)   !A
 | 
				
			||||||
@ -158,5 +150,5 @@ subroutine qra64a(dd,npts,nutc,nf1,nf2,nfqso,ntol,mode64,minsync,ndepth,   &
 | 
				
			|||||||
  endif  
 | 
					  endif  
 | 
				
			||||||
  call timer('qra64a  ',1)
 | 
					  call timer('qra64a  ',1)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
  return
 | 
					900 return
 | 
				
			||||||
end subroutine qra64a
 | 
					end subroutine qra64a
 | 
				
			||||||
 | 
				
			|||||||
		Loading…
	
	
			
			x
			
			
		
	
		Reference in New Issue
	
	Block a user