1program ft2 2 3 use packjt77 4 include 'gcom1.f90' 5 integer ft2audio,ptt 6 logical allok 7 character*20 pttport 8 character*8 arg 9 character*80 fname 10 integer*2 id2(30000) 11 12 open(12,file='all_ft2.txt',status='unknown',position='append') 13 nargs=iargc() 14 if(nargs.eq.1) then 15 call getarg(1,fname) 16 open(10,file=fname,status='old',access='stream') 17 read(10) id2(1:22) !Read (and ignore) the header 18 read(10) id2 !Read the Rx data 19 close(10) 20 call ft2_decode(fname(1:17),nfqso,id2,ndecodes,mycall,hiscall,nrx) 21 go to 999 22 endif 23 24 allok=.true. 25! Get home-station details 26 open(10,file='ft2.ini',status='old',err=1) 27 go to 2 281 print*,'Cannot open ft2.ini' 29 allok=.false. 302 read(10,*,err=3) mycall,mygrid,ndevin,ndevout,pttport,exch 31 go to 4 323 print*,'Error reading ft2.ini' 33 allok=.false. 344 if(index(pttport,'/').lt.1) read(pttport,*) nport 35 hiscall=' ' 36 hiscall_next=' ' 37 idevin=ndevin 38 idevout=ndevout 39 call padevsub(idevin,idevout) 40 if(idevin.ne.ndevin .or. idevout.ne.ndevout) allok=.false. 41 i1=0 42 i1=ptt(nport,1,1,iptt) 43 i1=ptt(nport,1,0,iptt) 44 if(i1.lt.0 .and. nport.ne.0) allok=.false. 45 if(.not.allok) then 46 write(*,"('Please fix setup error(s) and restart.')") 47 go to 999 48 endif 49 50 nright=1 51 iwrite=0 52 iwave=0 53 nwave=NTZ 54 nfsample=12000 55 ngo=1 56 npabuf=1152 57 ntxok=0 58 ntransmitting=0 59 tx_once=.false. 60 snrdb=99.0 61 txmsg='CQ K1JT FN20' 62 ltx=.false. 63 lrx=.false. 64 autoseq=.false. 65 QSO_in_progress=.false. 66 ntxed=0 67 68 if(nargs.eq.3) then 69 call getarg(1,txmsg) 70 call getarg(2,arg) 71 read(arg,*) f0 72 call getarg(3,arg) 73 read(arg,*) snrdb 74 tx_once=.true. 75 ftx=1500.0 76 call transmit(-1,ftx,iptt) 77 snrdb=99.0 78 endif 79 80! Start the audio streams 81 ierr=ft2audio(idevin,idevout,npabuf,nright,y1,y2,NRING,iwrite,itx, & 82 iwave,nwave+3*1152,nfsample,nTxOK,nTransmitting,ngo) 83 if(ierr.ne.0) then 84 print*,'Error',ierr,' starting audio input and/or output.' 85 endif 86 87999 end program ft2 88 89subroutine update(total_time,ic1,ic2) 90 91 use wavhdr 92 type(hdr) h 93 real*8 total_time 94 integer*8 count0,count1,clkfreq 95 integer ptt 96 integer*2 id(30000) 97 logical transmitted,level,ok 98 character*70 line 99 character cdatetime*17,fname*17,mode*8,band*6 100 include 'gcom1.f90' 101 data nt0/-1/,transmitted/.false./,snr/-99.0/ 102 data level/.false./ 103 save nt0,transmitted,level,snr,iptt 104 105 if(ic1.ne.0 .or. ic2.ne.0) then 106 if(ic1.eq.27 .and. ic2.eq.0) ngo=0 !ESC 107 if(nTxOK.eq.0 .and. ntransmitting.eq.0) then 108 nfunc=0 109 if(ic1.eq.0 .and. ic2.eq.59) nfunc=1 !F1 110 if(ic1.eq.0 .and. ic2.eq.60) nfunc=2 !F2 111 if(ic1.eq.0 .and. ic2.eq.61) nfunc=3 !F3 112 if(ic1.eq.0 .and. ic2.eq.62) nfunc=4 !F4 113 if(ic1.eq.0 .and. ic2.eq.63) nfunc=5 !F5 114 if(nfunc.eq.1 .or. (nfunc.ge.2 .and. hiscall.ne.' ')) then 115 ftx=1500.0 116 call transmit(nfunc,ftx,iptt) 117 endif 118 endif 119 if(ic1.eq.13 .and. ic2.eq.0) hiscall=hiscall_next 120 if((ic1.eq.97 .or. ic1.eq.65) .and. ic2.eq.0) autoseq=.not.autoseq 121 if((ic1.eq.108 .or. ic1.eq.76) .and. ic2.eq.0) level=.not.level 122 endif 123 124 if(ntransmitting.eq.1) transmitted=.true. 125 if(transmitted .and. ntransmitting.eq.0) then 126 i1=0 127 if(iptt.eq.1 .and. nport.gt.0) i1=ptt(nport,0,1,iptt) 128 if(tx_once .and. transmitted) stop 129 transmitted=.false. 130 endif 131 132 nt=2*total_time 133 if(nt.gt.nt0 .or. ic1.ne.0 .or. ic2.ne.0) then 134 if(level) then 135! Measure and display the average level of signal plus noise in past 0.5 s 136 k=iwrite-6000 137 if(k.lt.1) k=k+NRING 138 sq=0. 139 do i=1,6000 140 k=k+1 141 if(k.gt.NRING) k=k-NRING 142 x=y1(k) 143 sq=sq + x*x 144 enddo 145 sigdb=0. 146 if(sq.gt.0.0) sigdb=db(sq/6000.0) 147 n=sigdb 148 if(n.lt.1) n=1 149 if(n.gt.70) n=70 150 line=' ' 151 line(n:n)='*' 152 write(*,1030) sigdb,ntxed,autoseq,QSO_in_progress,(line(i:i),i=1,n) 1531030 format(f4.1,i3,2L2,1x,70a1) 154! write(*,1020) nt,total_time,iwrite,itx,ntxok,ntransmitting,ndecodes, & 155! snr,sigdb,line 156!1020 format(i6,f9.3,i10,i6,3i3,f6.0,f6.1,1x,a30) 157 endif 158 k=iwrite-30000 159 if(k.lt.1) k=k+NRING 160 do i=1,30000 161 k=k+1 162 if(k.gt.NRING) k=k-NRING 163 id(i)=y1(k) 164 enddo 165 nutc=0 166 nfqso=1500 167 ndecodes=0 168 if(maxval(abs(id)).gt.0) then 169 call system_clock(count0,clkfreq) 170 nrx=-1 171 call ft2_decode(cdatetime(),nfqso,id,ndecodes,mycall,hiscall,nrx) 172 call system_clock(count1,clkfreq) 173! tdecode=float(count1-count0)/float(clkfreq) 174 175 if(ndecodes.ge.1) then 176 fMHz=7.074 177 mode='FT2' 178 nsubmode=1 179 ntrperiod=0 180 h=default_header(12000,30000) 181 k=0 182 do i=1,250 183 sq=0 184 do n=1,120 185 k=k+1 186 x=id(k) 187 sq=sq + x*x 188 enddo 189 write(43,3043) i,0.01*i,1.e-4*sq 1903043 format(i7,f12.6,f12.3) 191 enddo 192 call set_wsjtx_wav_params(fMHz,mode,nsubmode,ntrperiod,id) 193 band="" 194 mode="" 195 nsubmode=-1 196 ntrperiod=-1 197 call get_wsjtx_wav_params(id,band,mode,nsubmode,ntrperiod,ok) 198! write(*,1010) band,ntrperiod,mode,char(ichar('A')-1+id(3)) 199!1010 format('Band: ',a6,' T/R period:',i4,' Mode: ',a8,1x,a1) 200 201 fname=cdatetime() 202 fname(14:17)='.wav' 203 open(13,file=fname,status='unknown',access='stream') 204 write(13) h,id 205 close(13) 206 endif 207 if(autoseq .and.nrx.eq.2) QSO_in_progress=.true. 208 if(autoseq .and. QSO_in_progress .and. nrx.ge.1 .and. nrx.le.4) then 209 lrx(nrx)=.true. 210 ftx=1500.0 211 if(ntxed.eq.1) then 212 if(nrx.eq.2) then 213 call transmit(3,ftx,iptt) 214 else 215 call transmit(1,ftx,iptt) 216 endif 217 endif 218 if(ntxed.eq.2) then 219 if(nrx.eq.3) then 220 call transmit(4,ftx,iptt) 221 QSO_in_progress=.false. 222 write(*,1032) 2231032 format('QSO complete: S+P side') 224 else 225 call transmit(2,ftx,iptt) 226 endif 227 endif 228 if(ntxed.eq.3) then 229 if(nrx.eq.4) then 230 QSO_in_progress=.false. 231 write(*,1034) 2321034 format('QSO complete: CQ side') 233 else 234 call transmit(3,ftx,iptt) 235 endif 236 endif 237 endif 238 endif 239 nt0=nt 240 endif 241 242 return 243end subroutine update 244 245character*17 function cdatetime() 246 character cdate*8,ctime*10 247 call date_and_time(cdate,ctime) 248 cdatetime=cdate(3:8)//'_'//ctime 249 return 250end function cdatetime 251 252subroutine transmit(nfunc,ftx,iptt) 253 include 'gcom1.f90' 254 character*17 cdatetime 255 integer ptt 256 257 if(nTxOK.eq.1) return 258 259 if(nfunc.eq.1) txmsg='CQ '//trim(mycall)//' '//mygrid 260 if(nfunc.eq.2) txmsg=trim(hiscall)//' '//trim(mycall)// & 261 ' 559 '//trim(exch) 262 if(nfunc.eq.3) txmsg=trim(hiscall)//' '//trim(mycall)// & 263 ' R 559 '//trim(exch) 264 if(nfunc.eq.4) txmsg=trim(hiscall)//' '//trim(mycall)//' RR73' 265 if(nfunc.eq.5) txmsg='TNX 73 GL' 266 call ft2_iwave(txmsg,ftx,snrdb,iwave) 267 iwave(23041:)=0 268 i1=ptt(nport,1,1,iptt) 269 ntxok=1 270 n=len(trim(txmsg)) 271 write(*,1010) cdatetime(),0,0.0,nint(ftx),(txmsg(i:i),i=1,n) 272 write(12,1010) cdatetime(),0,0.0,nint(ftx),(txmsg(i:i),i=1,n) 2731010 format(a17,i4,f6.2,i5,' Tx ',37a1) 274 if(nfunc.ge.1 .and. nfunc.le.4) ntxed=nfunc 275 if(nfunc.ge.1 .and. nfunc.le.5) ltx(nfunc)=.true. 276 if(nfunc.eq.2 .or. nfunc.eq.3) QSO_in_progress=.true. 277 278 return 279end subroutine transmit 280