mirror of
				https://github.com/saitohirga/WSJT-X.git
				synced 2025-10-30 20:40:28 -04:00 
			
		
		
		
	Update some comments, delete obsolete files.
This commit is contained in:
		
							parent
							
								
									054d098d8b
								
							
						
					
					
						commit
						f9e9bc01a1
					
				| @ -1,8 +1,5 @@ | ||||
| subroutine ft4_downsample(dd,newdata,f0,c) | ||||
| 
 | ||||
| ! Input: real data in dd() at sample rate 12000 Hz | ||||
| ! Output: Complex data in c(), sampled at 1200 Hz | ||||
| 
 | ||||
|    include 'ft4_params.f90' | ||||
|    parameter (NFFT2=NMAX/NDOWN) | ||||
|    real dd(NMAX) | ||||
|  | ||||
| @ -1,5 +1,5 @@ | ||||
| ! FT4  | ||||
| ! LDPC(174,91) code, four 4x4 Costas arrays for Sync | ||||
| ! LDPC(174,91) code, four 4x4 Costas arrays for sync, ramp-up and ramp-down symbols | ||||
| 
 | ||||
| parameter (KK=91)                     !Information bits (77 + CRC14) | ||||
| parameter (ND=87)                     !Data symbols | ||||
|  | ||||
							
								
								
									
										489
									
								
								lib/ft4/ft4b.f90
									
									
									
									
									
								
							
							
						
						
									
										489
									
								
								lib/ft4/ft4b.f90
									
									
									
									
									
								
							| @ -1,489 +0,0 @@ | ||||
| subroutine ft4b(cdatetime0,tbuf,nfa,nfb,nQSOProgress,ncontest,nfqso, & | ||||
|    iwave,ndecodes,mycall,hiscall,cqstr,line,data_dir) | ||||
| 
 | ||||
|    use packjt77 | ||||
|    include 'ft4_params.f90' | ||||
|    parameter (NSS=NSPS/NDOWN) | ||||
| 
 | ||||
|    character message*37,msgsent*37,msg0*37 | ||||
|    character c77*77 | ||||
|    character*61 line,linex(100) | ||||
|    character*37 decodes(100) | ||||
|    character*512 data_dir,fname | ||||
|    character*17 cdatetime0 | ||||
|    character*12 mycall,hiscall | ||||
|    character*12 mycall0,hiscall0 | ||||
|    character*6 hhmmss | ||||
|    character*4 cqstr,cqstr0 | ||||
| 
 | ||||
|    complex cd2(0:NMAX/NDOWN-1)                  !Complex waveform | ||||
|    complex cb(0:NMAX/NDOWN-1) | ||||
|    complex cd(0:NN*NSS-1)                       !Complex waveform | ||||
|    complex ctwk(2*NSS),ctwk2(2*NSS,-16:16) | ||||
|    complex csymb(NSS) | ||||
|    complex cs(0:3,NN) | ||||
|    real s4(0:3,NN) | ||||
| 
 | ||||
|    real bmeta(2*NN),bmetb(2*NN),bmetc(2*NN) | ||||
|    real a(5) | ||||
|    real llr(2*ND),llra(2*ND),llrb(2*ND),llrc(2*ND),llrd(2*ND) | ||||
|    real s2(0:255) | ||||
|    real candidate(3,100) | ||||
|    real savg(NH1),sbase(NH1) | ||||
| 
 | ||||
|    integer apbits(2*ND) | ||||
|    integer apmy_ru(28),aphis_fd(28) | ||||
|    integer icos4a(0:3),icos4b(0:3),icos4c(0:3),icos4d(0:3) | ||||
|    integer*2 iwave(NMAX)                 !Raw received data | ||||
|    integer*1 message77(77),rvec(77),apmask(2*ND),cw(2*ND) | ||||
|    integer*1 hbits(2*NN) | ||||
|    integer graymap(0:3) | ||||
|    integer ip(1) | ||||
|    integer nappasses(0:5)    ! # of decoding passes for QSO States 0-5 | ||||
|    integer naptypes(0:5,4)   ! nQSOProgress, decoding pass | ||||
|    integer mcq(29) | ||||
|    integer mrrr(19),m73(19),mrr73(19) | ||||
| 
 | ||||
|    logical nohiscall,unpk77_success | ||||
|    logical one(0:255,0:7)    ! 256 4-symbol sequences, 8 bits | ||||
|    logical first, dobigfft | ||||
| 
 | ||||
|    data icos4a/0,1,3,2/ | ||||
|    data icos4b/1,0,2,3/ | ||||
|    data icos4c/2,3,1,0/ | ||||
|    data icos4d/3,2,0,1/ | ||||
|    data graymap/0,1,3,2/ | ||||
|    data msg0/' '/ | ||||
|    data first/.true./ | ||||
|    data     mcq/0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0/ | ||||
|    data    mrrr/0,1,1,1,1,1,1,0,1,0,0,1,0,0,1,0,0,0,1/ | ||||
|    data     m73/0,1,1,1,1,1,1,0,1,0,0,1,0,1,0,0,0,0,1/ | ||||
|    data   mrr73/0,1,1,1,1,1,1,0,0,1,1,1,0,1,0,1,0,0,1/ | ||||
|    data rvec/0,1,0,0,1,0,1,0,0,1,0,1,1,1,1,0,1,0,0,0,1,0,0,1,1,0,1,1,0, & | ||||
|       1,0,0,1,0,1,1,0,0,0,0,1,0,0,0,1,0,1,0,0,1,1,1,1,0,0,1,0,1, & | ||||
|       0,1,0,1,0,1,1,0,1,1,1,1,1,0,0,0,1,0,1/ | ||||
|    save fs,dt,tt,txt,twopi,h,one,first,linex,apbits,nappasses,naptypes, & | ||||
|       mycall0,hiscall0,msg0,cqstr0,ctwk2 | ||||
|     | ||||
|    call clockit('ft4_deco',0) | ||||
|    hhmmss=cdatetime0(8:13) | ||||
| 
 | ||||
|    if(first) then | ||||
|       fs=12000.0/NDOWN                !Sample rate after downsampling | ||||
|       dt=1/fs                         !Sample interval after downsample (s) | ||||
|       tt=NSPS*dt                      !Duration of "itone" symbols (s) | ||||
|       txt=NZ*dt                       !Transmission length (s) without ramp up/down | ||||
|       twopi=8.0*atan(1.0) | ||||
|       h=1.0 | ||||
|       one=.false. | ||||
|       do i=0,255 | ||||
|          do j=0,7 | ||||
|             if(iand(i,2**j).ne.0) one(i,j)=.true. | ||||
|          enddo | ||||
|       enddo | ||||
| 
 | ||||
|       do idf=-16,16 | ||||
|          a=0. | ||||
|          a(1)=real(idf) | ||||
|          ctwk=1. | ||||
|          call clockit('twkfreq1',0) | ||||
|          call twkfreq1(ctwk,2*NSS,fs/2.0,a,ctwk2(:,idf)) | ||||
|          call clockit('twkfreq1',1) | ||||
|       enddo | ||||
| 
 | ||||
|       mrrr=2*mod(mrrr+rvec(59:77),2)-1 | ||||
|       m73=2*mod(m73+rvec(59:77),2)-1 | ||||
|       mrr73=2*mod(mrr73+rvec(59:77),2)-1 | ||||
|       nappasses(0)=2 | ||||
|       nappasses(1)=2 | ||||
|       nappasses(2)=2 | ||||
|       nappasses(3)=2 | ||||
|       nappasses(4)=2 | ||||
|       nappasses(5)=3 | ||||
| 
 | ||||
| ! iaptype | ||||
| !------------------------ | ||||
| !   1        CQ     ???    ???           (29 ap bits) | ||||
| !   2        MyCall ???    ???           (29 ap bits) | ||||
| !   3        MyCall DxCall ???           (58 ap bits) | ||||
| !   4        MyCall DxCall RRR           (77 ap bits) | ||||
| !   5        MyCall DxCall 73            (77 ap bits) | ||||
| !   6        MyCall DxCall RR73          (77 ap bits) | ||||
| !******** | ||||
|       naptypes(0,1:4)=(/1,2,0,0/) ! Tx6 selected (CQ) | ||||
|       naptypes(1,1:4)=(/2,3,0,0/) ! Tx1 | ||||
|       naptypes(2,1:4)=(/2,3,0,0/) ! Tx2 | ||||
|       naptypes(3,1:4)=(/3,6,0,0/) ! Tx3 | ||||
|       naptypes(4,1:4)=(/3,6,0,0/) ! Tx4 | ||||
|       naptypes(5,1:4)=(/3,1,2,0/) ! Tx5 | ||||
| 
 | ||||
|       mycall0='' | ||||
|       hiscall0='' | ||||
|       cqstr0='' | ||||
|       first=.false. | ||||
|    endif | ||||
| 
 | ||||
|    if(cqstr.ne.cqstr0) then | ||||
|       i0=index(cqstr,' ') | ||||
|       if(i0.le.1) then  | ||||
|          message='CQ A1AA AA01' | ||||
|       else | ||||
|          message='CQ '//cqstr(1:i0-1)//' A1AA AA01' | ||||
|       endif | ||||
|       i3=-1 | ||||
|       n3=-1 | ||||
|       call pack77(message,i3,n3,c77) | ||||
|       call unpack77(c77,1,msgsent,unpk77_success) | ||||
|       read(c77,'(29i1)') mcq | ||||
|       mcq=2*mod(mcq+rvec(1:29),2)-1 | ||||
|       cqstr0=cqstr | ||||
|    endif | ||||
| 
 | ||||
|    l1=index(mycall,char(0)) | ||||
|    if(l1.ne.0) mycall(l1:)=" " | ||||
|    l1=index(hiscall,char(0)) | ||||
|    if(l1.ne.0) hiscall(l1:)=" " | ||||
|    if(mycall.ne.mycall0 .or. hiscall.ne.hiscall0) then | ||||
|       apbits=0 | ||||
|       apbits(1)=99 | ||||
|       apbits(30)=99 | ||||
|       apmy_ru=0 | ||||
|       aphis_fd=0 | ||||
| 
 | ||||
|       if(len(trim(mycall)) .lt. 3) go to 10  | ||||
| 
 | ||||
|       nohiscall=.false. | ||||
|       hiscall0=hiscall | ||||
|       if(len(trim(hiscall0)).lt.3) then | ||||
|          hiscall0=mycall  ! use mycall for dummy hiscall - mycall won't be hashed. | ||||
|          nohiscall=.true. | ||||
|       endif | ||||
|       message=trim(mycall)//' '//trim(hiscall0)//' RR73' | ||||
|       i3=-1 | ||||
|       n3=-1 | ||||
|       call pack77(message,i3,n3,c77) | ||||
|       call unpack77(c77,1,msgsent,unpk77_success) | ||||
|       if(i3.ne.1 .or. (message.ne.msgsent) .or. .not.unpk77_success) go to 10  | ||||
|       read(c77,'(77i1)') message77 | ||||
|       apmy_ru=2*mod(message77(1:28)+rvec(2:29),2)-1 | ||||
|       aphis_fd=2*mod(message77(30:57)+rvec(29:56),2)-1 | ||||
|       message77=mod(message77+rvec,2) | ||||
|       call encode174_91(message77,cw) | ||||
|       apbits=2*cw-1 | ||||
|       if(nohiscall) apbits(30)=99 | ||||
| 
 | ||||
| 10    continue | ||||
|       mycall0=mycall | ||||
|       hiscall0=hiscall | ||||
|    endif | ||||
|    candidate=0.0 | ||||
|    ncand=0 | ||||
|    syncmin=1.2 | ||||
|    maxcand=100 | ||||
| 
 | ||||
|    fa=nfa | ||||
|    fb=nfb | ||||
|    call clockit('getcand4',0) | ||||
|    call getcandidates4(iwave,fa,fb,syncmin,nfqso,maxcand,savg,candidate,   & | ||||
|       ncand,sbase) | ||||
|    call clockit('getcand4',1) | ||||
| 
 | ||||
|    ndecodes=0 | ||||
|    dobigfft=.true. | ||||
|    do icand=1,ncand | ||||
|       f0=candidate(1,icand) | ||||
|       snr=candidate(3,icand)-1.0 | ||||
|       if( f0.le.10.0 .or. f0.ge.4990.0 ) cycle | ||||
|       call clockit('ft4_down',0) | ||||
|       call ft4_downsample(iwave,dobigfft,f0,cd2)  !Downsample from 512 to 32 Sa/Symbol | ||||
|       if(dobigfft) dobigfft=.false. | ||||
|       call clockit('ft4_down',1) | ||||
| 
 | ||||
|       sum2=sum(cd2*conjg(cd2))/(real(NMAX)/real(NDOWN)) | ||||
|       if(sum2.gt.0.0) cd2=cd2/sqrt(sum2) | ||||
| ! Sample rate is now 12000/16 = 750 samples/second | ||||
|       do isync=1,2 | ||||
|          if(isync.eq.1) then | ||||
|             idfmin=-12 | ||||
|             idfmax=12 | ||||
|             idfstp=3 | ||||
|             ibmin=0 | ||||
|             ibmax=216                     !Max DT = 216/750 = 0.288 s | ||||
|             ibstp=4 | ||||
|          else | ||||
|             idfmin=idfbest-4 | ||||
|             idfmax=idfbest+4 | ||||
|             idfstp=1 | ||||
|             ibmin=max(0,ibest-5) | ||||
|             ibmax=min(ibest+5,NMAX/NDOWN-1) | ||||
|             ibstp=1 | ||||
|          endif | ||||
|          ibest=-1 | ||||
|          smax=-99. | ||||
|          idfbest=0 | ||||
|          do idf=idfmin,idfmax,idfstp | ||||
| 
 | ||||
|             call clockit('sync4d  ',0) | ||||
|             do istart=ibmin,ibmax,ibstp | ||||
|                call sync4d(cd2,istart,ctwk2(:,idf),1,sync)  !Find sync power | ||||
|                if(sync.gt.smax) then | ||||
|                   smax=sync | ||||
|                   ibest=istart | ||||
|                   idfbest=idf | ||||
|                endif | ||||
|             enddo | ||||
|             call clockit('sync4d  ',1) | ||||
| 
 | ||||
|          enddo | ||||
|       enddo | ||||
|       f0=f0+real(idfbest) | ||||
|       if( f0.le.10.0 .or. f0.ge.4990.0 ) cycle | ||||
| 
 | ||||
|       call clockit('ft4down ',0) | ||||
|       call ft4_downsample(iwave,dobigfft,f0,cb) !Final downsample with corrected f0 | ||||
|       call clockit('ft4down ',1) | ||||
|       sum2=sum(abs(cb)**2)/(real(NSS)*NN) | ||||
|       if(sum2.gt.0.0) cb=cb/sqrt(sum2) | ||||
|       cd=cb(ibest:ibest+NN*NSS-1) | ||||
|       call clockit('four2a  ',0) | ||||
|       do k=1,NN | ||||
|          i1=(k-1)*NSS | ||||
|          csymb=cd(i1:i1+NSS-1) | ||||
|          call four2a(csymb,NSS,1,-1,1) | ||||
|          cs(0:3,k)=csymb(1:4) | ||||
|          s4(0:3,k)=abs(csymb(1:4)) | ||||
|       enddo | ||||
|       call clockit('four2a  ',1) | ||||
| 
 | ||||
| ! Sync quality check | ||||
|       is1=0 | ||||
|       is2=0 | ||||
|       is3=0 | ||||
|       is4=0 | ||||
|       do k=1,4 | ||||
|          ip=maxloc(s4(:,k)) | ||||
|          if(icos4a(k-1).eq.(ip(1)-1)) is1=is1+1 | ||||
|          ip=maxloc(s4(:,k+33)) | ||||
|          if(icos4b(k-1).eq.(ip(1)-1)) is2=is2+1 | ||||
|          ip=maxloc(s4(:,k+66)) | ||||
|          if(icos4c(k-1).eq.(ip(1)-1)) is3=is3+1 | ||||
|          ip=maxloc(s4(:,k+99)) | ||||
|          if(icos4d(k-1).eq.(ip(1)-1)) is4=is4+1 | ||||
|       enddo | ||||
|       nsync=is1+is2+is3+is4   !Number of correct hard sync symbols, 0-16 | ||||
|       if(smax .lt. 0.7 .or. nsync .lt. 8) cycle | ||||
| 
 | ||||
|       do nseq=1,3             !Try coherent sequences of 1, 2, and 4 symbols | ||||
|          if(nseq.eq.1) nsym=1 | ||||
|          if(nseq.eq.2) nsym=2 | ||||
|          if(nseq.eq.3) nsym=4 | ||||
|          nt=2**(2*nsym) | ||||
|          do ks=1,NN-nsym+1,nsym  !87+16=103 symbols. | ||||
|             amax=-1.0 | ||||
|             do i=0,nt-1 | ||||
|                i1=i/64 | ||||
|                i2=iand(i,63)/16 | ||||
|                i3=iand(i,15)/4 | ||||
|                i4=iand(i,3) | ||||
|                if(nsym.eq.1) then | ||||
|                   s2(i)=abs(cs(graymap(i4),ks)) | ||||
|                elseif(nsym.eq.2) then | ||||
|                   s2(i)=abs(cs(graymap(i3),ks)+cs(graymap(i4),ks+1)) | ||||
|                elseif(nsym.eq.4) then | ||||
|                   s2(i)=abs(cs(graymap(i1),ks  ) + & | ||||
|                      cs(graymap(i2),ks+1) + & | ||||
|                      cs(graymap(i3),ks+2) + & | ||||
|                      cs(graymap(i4),ks+3)   & | ||||
|                      ) | ||||
|                else | ||||
|                   print*,"Error - nsym must be 1, 2, or 4." | ||||
|                endif | ||||
|             enddo | ||||
|             ipt=1+(ks-1)*2 | ||||
|             if(nsym.eq.1) ibmax=1 | ||||
|             if(nsym.eq.2) ibmax=3 | ||||
|             if(nsym.eq.4) ibmax=7 | ||||
|             do ib=0,ibmax | ||||
|                bm=maxval(s2(0:nt-1),one(0:nt-1,ibmax-ib)) - & | ||||
|                   maxval(s2(0:nt-1),.not.one(0:nt-1,ibmax-ib)) | ||||
|                if(ipt+ib.gt.2*NN) cycle | ||||
|                if(nsym.eq.1) then | ||||
|                   bmeta(ipt+ib)=bm | ||||
|                elseif(nsym.eq.2) then | ||||
|                   bmetb(ipt+ib)=bm | ||||
|                elseif(nsym.eq.4) then | ||||
|                   bmetc(ipt+ib)=bm | ||||
|                endif | ||||
|             enddo | ||||
|          enddo | ||||
|       enddo | ||||
| 
 | ||||
|       bmetb(205:206)=bmeta(205:206) | ||||
|       bmetc(201:204)=bmetb(201:204) | ||||
|       bmetc(205:206)=bmeta(205:206) | ||||
| 
 | ||||
|       call clockit('normaliz',0) | ||||
|       call normalizebmet(bmeta,2*NN) | ||||
|       call normalizebmet(bmetb,2*NN) | ||||
|       call normalizebmet(bmetc,2*NN) | ||||
|       call clockit('normaliz',1) | ||||
| 
 | ||||
|       hbits=0 | ||||
|       where(bmeta.ge.0) hbits=1 | ||||
|       ns1=count(hbits(  1:  8).eq.(/0,0,0,1,1,0,1,1/)) | ||||
|       ns2=count(hbits( 67: 74).eq.(/0,1,0,0,1,1,1,0/)) | ||||
|       ns3=count(hbits(133:140).eq.(/1,1,1,0,0,1,0,0/)) | ||||
|       ns4=count(hbits(199:206).eq.(/1,0,1,1,0,0,0,1/)) | ||||
|       nsync_qual=ns1+ns2+ns3+ns4 | ||||
|       if(nsync_qual.lt. 20) cycle | ||||
| 
 | ||||
|       scalefac=2.83 | ||||
|       llra(  1: 58)=bmeta(  9: 66) | ||||
|       llra( 59:116)=bmeta( 75:132) | ||||
|       llra(117:174)=bmeta(141:198) | ||||
|       llra=scalefac*llra | ||||
|       llrb(  1: 58)=bmetb(  9: 66) | ||||
|       llrb( 59:116)=bmetb( 75:132) | ||||
|       llrb(117:174)=bmetb(141:198) | ||||
|       llrb=scalefac*llrb | ||||
|       llrc(  1: 58)=bmetc(  9: 66) | ||||
|       llrc( 59:116)=bmetc( 75:132) | ||||
|       llrc(117:174)=bmetc(141:198) | ||||
|       llrc=scalefac*llrc | ||||
| 
 | ||||
|       apmag=maxval(abs(llra))*1.1 | ||||
|       npasses=3+nappasses(nQSOProgress) | ||||
|       if(ncontest.ge.5) npasses=3  ! Don't support Fox and Hound | ||||
|       do ipass=1,npasses | ||||
|          if(ipass.eq.1) llr=llra | ||||
|          if(ipass.eq.2) llr=llrb | ||||
|          if(ipass.eq.3) llr=llrc | ||||
|          if(ipass.le.3) then | ||||
|             apmask=0 | ||||
|             iaptype=0 | ||||
|          endif | ||||
| 
 | ||||
|          if(ipass .gt. 3) then | ||||
|             llrd=llrc | ||||
|             iaptype=naptypes(nQSOProgress,ipass-3) | ||||
| 
 | ||||
| ! ncontest=0 : NONE | ||||
| !          1 : NA_VHF | ||||
| !          2 : EU_VHF | ||||
| !          3 : FIELD DAY | ||||
| !          4 : RTTY | ||||
| !          5 : FOX | ||||
| !          6 : HOUND | ||||
| ! | ||||
| ! Conditions that cause us to bail out of AP decoding | ||||
|             napwid=50 | ||||
|             if(ncontest.le.4 .and. iaptype.ge.3 .and. (abs(f0-nfqso).gt.napwid) ) cycle | ||||
|             if(iaptype.ge.2 .and. apbits(1).gt.1) cycle  ! No, or nonstandard, mycall | ||||
|             if(iaptype.ge.3 .and. apbits(30).gt.1) cycle ! No, or nonstandard, dxcall | ||||
| 
 | ||||
|             if(iaptype.eq.1) then  ! CQ or CQ TEST or CQ FD or CQ RU or CQ SCC | ||||
|                apmask=0 | ||||
|                apmask(1:29)=1 | ||||
|                llrd(1:29)=apmag*mcq(1:29) | ||||
|             endif | ||||
| 
 | ||||
|             if(iaptype.eq.2) then ! MyCall,???,??? | ||||
|                apmask=0 | ||||
|                if(ncontest.eq.0.or.ncontest.eq.1) then | ||||
|                   apmask(1:29)=1 | ||||
|                   llrd(1:29)=apmag*apbits(1:29) | ||||
|                else if(ncontest.eq.2) then | ||||
|                   apmask(1:28)=1 | ||||
|                   llrd(1:28)=apmag*apbits(1:28) | ||||
|                else if(ncontest.eq.3) then | ||||
|                   apmask(1:28)=1 | ||||
|                   llrd(1:28)=apmag*apbits(1:28) | ||||
|                else if(ncontest.eq.4) then | ||||
|                   apmask(2:29)=1 | ||||
|                   llrd(2:29)=apmag*apmy_ru(1:28) | ||||
|                endif | ||||
|             endif | ||||
| 
 | ||||
|             if(iaptype.eq.3) then ! MyCall,DxCall,??? | ||||
|                apmask=0 | ||||
|                if(ncontest.eq.0.or.ncontest.eq.1.or.ncontest.eq.2) then | ||||
|                   apmask(1:58)=1 | ||||
|                   llrd(1:58)=apmag*apbits(1:58) | ||||
|                else if(ncontest.eq.3) then ! Field Day | ||||
|                   apmask(1:56)=1 | ||||
|                   llrd(1:28)=apmag*apbits(1:28) | ||||
|                   llrd(29:56)=apmag*aphis_fd(1:28) | ||||
|                else if(ncontest.eq.4) then ! RTTY RU | ||||
|                   apmask(2:57)=1 | ||||
|                   llrd(2:29)=apmag*apmy_ru(1:28) | ||||
|                   llrd(30:57)=apmag*apbits(30:57) | ||||
|                endif | ||||
|             endif | ||||
| 
 | ||||
|             if(iaptype.eq.4 .or. iaptype.eq.5 .or. iaptype.eq.6) then | ||||
|                apmask=0 | ||||
|                if(ncontest.le.4) then | ||||
|                   apmask(1:91)=1   ! mycall, hiscall, RRR|73|RR73 | ||||
|                   if(iaptype.eq.6) llrd(1:91)=apmag*apbits(1:91) | ||||
|                endif | ||||
|             endif | ||||
| 
 | ||||
|             llr=llrd | ||||
|          endif | ||||
|          max_iterations=40 | ||||
|          message77=0 | ||||
|          call clockit('bpdecode',0) | ||||
|          call bpdecode174_91(llr,apmask,max_iterations,message77,     & | ||||
|             cw,nharderror,niterations) | ||||
|          call clockit('bpdecode',1) | ||||
|          if(sum(message77).eq.0) cycle | ||||
|          if( nharderror.ge.0 ) then | ||||
|             message77=mod(message77+rvec,2) ! remove rvec scrambling | ||||
|             write(c77,'(77i1)') message77(1:77) | ||||
|             call unpack77(c77,1,message,unpk77_success) | ||||
|             idupe=0 | ||||
|             do i=1,ndecodes | ||||
|                if(decodes(i).eq.message) idupe=1 | ||||
|             enddo | ||||
|             if(ibest.le.10 .and. message.eq.msg0) idupe=1   !Already decoded | ||||
|             if(idupe.eq.1) exit | ||||
|             ndecodes=ndecodes+1 | ||||
|             decodes(ndecodes)=message | ||||
|             if(snr.gt.0.0) then | ||||
|                xsnr=10*log10(snr)-14.0 | ||||
|             else | ||||
|                xsnr=-20.0 | ||||
|             endif | ||||
|             nsnr=nint(max(-20.0,xsnr)) | ||||
|             freq=f0 | ||||
|             tsig=mod(tbuf + ibest/750.0,100.0) | ||||
| 
 | ||||
|             write(line,1000) hhmmss,nsnr,tsig,nint(freq),message | ||||
| 1000        format(a6,i4,f5.1,i5,' + ',1x,a37) | ||||
|             l1=index(data_dir,char(0))-1 | ||||
|             if(l1.ge.1) data_dir(l1+1:l1+1)="/" | ||||
|             fname=data_dir(1:l1+1)//'all_ft4.txt' | ||||
|             open(24,file=trim(fname),status='unknown',position='append') | ||||
|             write(24,1002) cdatetime0,nsnr,tsig,nint(freq),message,    & | ||||
|                nharderror,nsync_qual,ipass,niterations,iaptype,nsync | ||||
|             if(hhmmss.eq.'      ') write(*,1002) cdatetime0,nsnr,             & | ||||
|                tsig,nint(freq),message,nharderror,nsync_qual,ipass,    & | ||||
|                niterations,iaptype | ||||
| 1002        format(a17,i4,f5.1,i5,' Rx  ',a37,6i4) | ||||
|             close(24) | ||||
|             linex(ndecodes)=line | ||||
|             if(ibest.ge.ibmax-15) msg0=message         !Possible dupe candidate | ||||
|             exit | ||||
|          endif | ||||
|       enddo !Sequence estimation | ||||
|    enddo    !Candidate list | ||||
|    call clockit('ft4_deco',1) | ||||
|    call clockit2(data_dir) | ||||
|    call clockit('ft4_deco',101) | ||||
|    return | ||||
| 
 | ||||
|  entry get_ft4msg(idecode,line) | ||||
|    line=linex(idecode) | ||||
|    return | ||||
| 
 | ||||
|  end subroutine ft4b | ||||
| @ -1,83 +0,0 @@ | ||||
| program ft4d | ||||
| 
 | ||||
|    include 'ft4_params.f90' | ||||
|    character*8 arg | ||||
|    character*17 cdatetime  | ||||
|    character*512 data_dir | ||||
|    character*12 mycall | ||||
|    character*12 hiscall | ||||
|    character*80 infile | ||||
|    character*61 line | ||||
|    character*4  cqstr | ||||
|    real*8 fMHz | ||||
|    integer ihdr(11) | ||||
|    integer*2 iwave(240000)                !20*12000 | ||||
| 
 | ||||
|    fs=12000.0/NDOWN                       !Sample rate | ||||
|    dt=1/fs                                !Sample interval after downsample (s) | ||||
|    tt=NSPS*dt                             !Duration of "itone" symbols (s) | ||||
|    baud=1.0/tt                            !Keying rate for "itone" symbols (baud) | ||||
|    txt=NZ*dt                              !Transmission length (s) | ||||
| 
 | ||||
|    nargs=iargc() | ||||
|    if(nargs.lt.1) then | ||||
|       print*,'Usage:   ft4d [-a <data_dir>] [-f fMHz] [-n nQSOProgress] file1 [file2 ...]' | ||||
|       go to 999 | ||||
|    endif | ||||
|    iarg=1 | ||||
|    data_dir="." | ||||
|    call getarg(iarg,arg) | ||||
|    if(arg(1:2).eq.'-a') then | ||||
|       call getarg(iarg+1,data_dir) | ||||
|       iarg=iarg+2 | ||||
|    endif | ||||
|    call getarg(iarg,arg) | ||||
|    if(arg(1:2).eq.'-f') then | ||||
|       call getarg(iarg+1,arg) | ||||
|       read(arg,*) fMHz | ||||
|       iarg=iarg+2 | ||||
|    endif | ||||
|    nQSOProgress=0 | ||||
|    if(arg(1:2).eq.'-n') then | ||||
|       call getarg(iarg+1,arg) | ||||
|       read(arg,*) nQSOProgress  | ||||
|       iarg=iarg+2 | ||||
|    endif | ||||
|    nfa=10 | ||||
|    nfb=4990 | ||||
|    ndecodes=0 | ||||
|    nfqso=1500 | ||||
|    mycall="K9AN" | ||||
|    hiscall="K1JT" | ||||
|    ncontest=4 | ||||
|    cqstr="RU  " | ||||
| 
 | ||||
|    do ifile=iarg,nargs | ||||
|       call getarg(ifile,infile) | ||||
|       open(10,file=infile,status='old',access='stream') | ||||
|       read(10) ihdr | ||||
|       npts=min(ihdr(11)/2,180000) | ||||
|       read(10) iwave(1:npts) | ||||
|       close(10) | ||||
|       cdatetime=infile | ||||
|       j2=index(infile,'.wav') | ||||
|       if(j2.ge.14) cdatetime=infile(j2-13:j2)//'000' | ||||
|       istep=3456 | ||||
|       nsteps=(npts-52800)/istep + 1 | ||||
|       do n=1,nsteps | ||||
|          i0=(n-1)*istep + 1 | ||||
|          tbuf=(i0-1)/12000.0 | ||||
|          call ft4b(cdatetime,tbuf,nfa,nfb,nQSOProgress,ncontest,           & | ||||
|               nfqso,iwave(i0),ndecodes,mycall,hiscall,cqstr,line,data_dir) | ||||
|          do idecode=1,ndecodes | ||||
|             call get_ft4msg(idecode,line) | ||||
|             write(*,'(a61)') line | ||||
|          enddo | ||||
|       enddo        !steps | ||||
|    enddo           !files | ||||
| 
 | ||||
|    call four2a(xx,-1,1,-1,1)   !Destroy FFTW plans to free their memory | ||||
| 
 | ||||
| 999 end program ft4d | ||||
| 
 | ||||
| 
 | ||||
| @ -11,7 +11,7 @@ subroutine genft4(msg0,ichk,msgsent,msgbits,i4tone) | ||||
| ! s16 + 87symbols + 2 ramp up/down = 105 total channel symbols | ||||
| ! r1 + s4 + d29 + s4 + d29 + s4 + d29 + s4 + r1 | ||||
| 
 | ||||
| ! Message duration: TxT = 105*512/12000 = 4.48 s | ||||
| ! Message duration: TxT = 105*576/12000 = 5.04 s | ||||
|    | ||||
| ! use iso_c_binding, only: c_loc,c_size_t | ||||
| 
 | ||||
|  | ||||
		Loading…
	
	
			
			x
			
			
		
	
		Reference in New Issue
	
	Block a user