| 
									
										
										
										
											2019-01-25 16:01:34 -06:00
										 |  |  | program ft4d
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |    include 'ft4_params.f90'
 | 
					
						
							| 
									
										
										
										
											2019-01-26 11:42:07 -06:00
										 |  |  |    character*8 arg
 | 
					
						
							|  |  |  |    character*17 cdatetime 
 | 
					
						
							| 
									
										
										
										
											2019-02-01 11:56:08 -05:00
										 |  |  |    character*512 data_dir
 | 
					
						
							| 
									
										
										
										
											2019-02-07 18:48:38 -06:00
										 |  |  |    character*12 mycall
 | 
					
						
							|  |  |  |    character*12 hiscall
 | 
					
						
							| 
									
										
										
										
											2019-01-26 11:42:07 -06:00
										 |  |  |    character*80 infile
 | 
					
						
							|  |  |  |    character*61 line
 | 
					
						
							| 
									
										
										
										
											2019-03-04 17:26:24 -06:00
										 |  |  |    character*4  cqstr
 | 
					
						
							| 
									
										
										
										
											2019-01-25 16:01:34 -06:00
										 |  |  |    real*8 fMHz
 | 
					
						
							|  |  |  |    integer ihdr(11)
 | 
					
						
							| 
									
										
										
										
											2019-03-28 10:59:20 -05:00
										 |  |  |    integer*2 iwave(240000)                !20*12000
 | 
					
						
							| 
									
										
										
										
											2019-01-25 16:01:34 -06:00
										 |  |  | 
 | 
					
						
							|  |  |  |    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
 | 
					
						
							| 
									
										
										
										
											2019-02-07 18:48:38 -06:00
										 |  |  |       print*,'Usage:   ft4d [-a <data_dir>] [-f fMHz] [-n nQSOProgress] file1 [file2 ...]'
 | 
					
						
							| 
									
										
										
										
											2019-01-25 16:01:34 -06:00
										 |  |  |       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
 | 
					
						
							| 
									
										
										
										
											2019-02-07 18:48:38 -06:00
										 |  |  |    nQSOProgress=0
 | 
					
						
							|  |  |  |    if(arg(1:2).eq.'-n') then
 | 
					
						
							|  |  |  |       call getarg(iarg+1,arg)
 | 
					
						
							|  |  |  |       read(arg,*) nQSOProgress 
 | 
					
						
							|  |  |  |       iarg=iarg+2
 | 
					
						
							|  |  |  |    endif
 | 
					
						
							| 
									
										
										
										
											2019-03-21 13:27:10 -05:00
										 |  |  |    nfa=10
 | 
					
						
							|  |  |  |    nfb=4990
 | 
					
						
							| 
									
										
										
										
											2019-02-14 14:09:22 -05:00
										 |  |  |    ndecodes=0
 | 
					
						
							| 
									
										
										
										
											2019-02-07 18:48:38 -06:00
										 |  |  |    nfqso=1500
 | 
					
						
							|  |  |  |    mycall="K9AN"
 | 
					
						
							|  |  |  |    hiscall="K1JT"
 | 
					
						
							| 
									
										
										
										
											2019-03-04 17:26:24 -06:00
										 |  |  |    ncontest=4
 | 
					
						
							|  |  |  |    cqstr="RU  "
 | 
					
						
							| 
									
										
										
										
											2019-01-25 16:01:34 -06:00
										 |  |  | 
 | 
					
						
							|  |  |  |    do ifile=iarg,nargs
 | 
					
						
							|  |  |  |       call getarg(ifile,infile)
 | 
					
						
							|  |  |  |       open(10,file=infile,status='old',access='stream')
 | 
					
						
							| 
									
										
										
										
											2019-02-14 15:10:41 -05:00
										 |  |  |       read(10) ihdr
 | 
					
						
							| 
									
										
										
										
											2019-03-26 14:00:32 -04:00
										 |  |  |       npts=min(ihdr(11)/2,180000)
 | 
					
						
							| 
									
										
										
										
											2019-02-14 15:10:41 -05:00
										 |  |  |       read(10) iwave(1:npts)
 | 
					
						
							| 
									
										
										
										
											2019-01-25 16:01:34 -06:00
										 |  |  |       close(10)
 | 
					
						
							| 
									
										
										
										
											2019-03-28 09:21:01 -04:00
										 |  |  |       cdatetime=infile
 | 
					
						
							|  |  |  |       j2=index(infile,'.wav')
 | 
					
						
							|  |  |  |       if(j2.ge.14) cdatetime=infile(j2-13:j2)//'000'
 | 
					
						
							| 
									
										
										
										
											2019-02-21 10:08:18 -05:00
										 |  |  |       istep=3456
 | 
					
						
							|  |  |  |       nsteps=(npts-52800)/istep + 1
 | 
					
						
							| 
									
										
										
										
											2019-02-14 15:10:41 -05:00
										 |  |  |       do n=1,nsteps
 | 
					
						
							| 
									
										
										
										
											2019-02-21 10:08:18 -05:00
										 |  |  |          i0=(n-1)*istep + 1
 | 
					
						
							| 
									
										
										
										
											2019-02-15 09:06:41 -05:00
										 |  |  |          tbuf=(i0-1)/12000.0
 | 
					
						
							| 
									
										
										
										
											2019-04-01 14:23:10 -04:00
										 |  |  |          call ft4b(cdatetime,tbuf,nfa,nfb,nQSOProgress,ncontest,           &
 | 
					
						
							| 
									
										
										
										
											2019-03-09 10:03:01 -06:00
										 |  |  |               nfqso,iwave(i0),ndecodes,mycall,hiscall,cqstr,line,data_dir)
 | 
					
						
							| 
									
										
										
										
											2019-02-14 15:10:41 -05:00
										 |  |  |          do idecode=1,ndecodes
 | 
					
						
							| 
									
										
										
										
											2019-03-09 10:03:01 -06:00
										 |  |  |             call get_ft4msg(idecode,line)
 | 
					
						
							| 
									
										
										
										
											2019-02-14 15:10:41 -05:00
										 |  |  |             write(*,'(a61)') line
 | 
					
						
							|  |  |  |          enddo
 | 
					
						
							|  |  |  |       enddo        !steps
 | 
					
						
							|  |  |  |    enddo           !files
 | 
					
						
							| 
									
										
										
										
											2019-01-25 16:01:34 -06:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2019-02-15 08:59:41 -05:00
										 |  |  |    call four2a(xx,-1,1,-1,1)   !Destroy FFTW plans to free their memory
 | 
					
						
							| 
									
										
										
										
											2019-01-25 16:01:34 -06:00
										 |  |  | 
 | 
					
						
							|  |  |  | 999 end program ft4d
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | 
 |