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