1program fox_sim
2
3! Simulates QSO exchanges using the proposed FT8 "DXpedition" mode.
4  parameter (MAXSIG=5,NCALLS=268)
5  character*6 xcall(NCALLS)
6  character*4 xgrid(NCALLS)
7  integer isnr(NCALLS)
8
9  character*32 fmsg(MAXSIG),fm
10  character*22 hmsg(MAXSIG),hm
11  character*16 log
12  character*6 called(MAXSIG)
13  character*4 gcalled(MAXSIG)
14  character*6 MyCall
15  character*4 MyGrid
16  character*8 arg
17  character*1 c1,c2,c3,c4
18  integer ntot(MAXSIG),irate(MAXSIG),ntimes(MAXSIG)
19  logical logit
20  common/dxpfifo/nc,isnr,xcall,xgrid
21
22  nargs=iargc()
23  if(nargs.ne.2 .and. nargs.ne.4) then
24     print*,'Usage: fox_sim  nseq maxtimes'
25     print*,'       fox_sim  nseq maxtimes nsig fail'
26     print*,' '
27     print*,' nseq:     number of T/R sequences to execute'
28     print*,' maxtimes: number of repeats of same Tx message'
29     print*,' nsig:     number of simultaneous Tx sigals'
30     print*,' fail:     receiving error rate'
31     go to 999
32  endif
33  ii1=1
34  ii2=5
35  jj1=0
36  jj2=5
37  nseq=80
38  if(nargs.ge.2) then
39     call getarg(1,arg)
40     read(arg,*) nseq
41     call getarg(2,arg)
42     read(arg,*) maxtimes
43  endif
44  if(nargs.eq.4) then
45     call getarg(3,arg)
46     read(arg,*) nsig
47     call getarg(4,arg)
48     read(arg,*) fail
49     ii1=nsig
50     ii2=nsig
51     jj1=nint(10*fail)
52     jj2=nint(10*fail)
53  endif
54
55! Read a file with calls and grids; insert random S/N values.
56! This is used in place of an operator-selected FIFO
57  open(10,file='xcall.txt',status='old')
58  do i=1,NCALLS
59     read(10,1000) xcall(i),xgrid(i)
601000 format(a6,7x,a4)
61     if(i.ne.-99) cycle
62     j=mod(i-1,26)
63     c1=char(ichar('A')+j)
64     k=mod((i-1)/26,26)
65     c2=char(ichar('A')+k)
66     n=mod((i-1)/260,10)
67     c3=char(ichar('0')+n)
68     xcall(i)='K'//c2//c3//c1//c1//c1
69
70     j=mod(i-1,18)
71     c1=char(ichar('A')+j)
72     k=mod((i-1)/18,18)
73     c2=char(ichar('A')+k)
74     n=mod((i-1)/10,10)
75     c4=char(ichar('0')+n)
76     n=mod((i-1)/100,10)
77     c3=char(ichar('0')+n)
78     xgrid(i)=c1//c2//c3//c4
79
80     call random_number(x)
81     isnr(i)=-20+int(40*x)
82  enddo
83!  close(10)
84
85! Write headings for the summary file
86  minutes=nseq/4
87  write(13,1002) nseq,minutes,maxtimes
881002 format(/'Nseq:',i4,'   Minutes:',i3,'   Maxtimes:',i2//                   &
89    18x,'Logged QSOs',22x,'Rate (QSOs/hour)'/                                  &
90    'fail Nsig: 1     2     3     4     5          1     2     3     4     5'/ &
91    71('-'))
92
93  write(*,1003)
941003 format('Seq  s n Fox messages                      Hound messages    Logged info        i Rate'/87('-'))
95
96  ntot=0
97  irate=0
98  MyCall='KH1DX'
99  MyGrid='AJ10'
100
101  do jj=jj1,jj2                        !Loop over Rx failure rates
102     fail=0.1*jj
103     do ii=ii1,ii2                     !Loop over range of nsig
104        nc=0                           !Set FIFO pointer to top
105        ntimes=1
106        nsig=ii
107        nlogged=0
108        fmsg="CQ KH1DX AJ10"
109        hmsg=""
110        called="      "
111        do iseq=0,nseq                 !Loop over specified number of sequences
112           if(iand(iseq,1).eq.0) then
113              do j=1,nsig              !Loop over Fox's Tx slots
114                 fm=fmsg(j)
115                 hm=hmsg(j)
116
117! Call fox_tx to determine the next Tx message for this slot
118                 call fox_tx(maxtimes,fail,called(j),gcalled(j),hm,fm,    &
119                      ntimes(j),log,logit)
120
121                 fmsg(j)=fm
122                 if(logit) then
123! Log this QSO
124                    nlogged=nlogged+1
125                    nrate=0
126                    if(iseq.gt.0) nrate=nint(nlogged*240.0/iseq)
127                    write(*,1010) iseq,j,ntimes(j),fmsg(j),log,nlogged,nrate
1281010                format(i4.4,2i2,1x,a32,20x,a16,2i4)
129                    ! call log_routine()
130                 else
131                    write(*,1010) iseq,j,ntimes(j),fmsg(j)
132                 endif
133              enddo
134              ! call transmit()
135           endif
136
137           if(iand(iseq,1).eq.1) then
138              do j=1,nsig              !Listen for expected responses
139                 fm=fmsg(j)
140                 call fox_rx(fail,called(j),fm,hm)
141                 if(j.ge.2) then
142                    if(hm.eq.hmsg(j-1)) hm=""
143                 endif
144                 hmsg(j)=hm
145                 write(*,1020) iseq,j,hmsg(j)
1461020             format(i4.4,i2,37x,a22)
147              enddo
148           endif
149           write(*,1021)
1501021       format(87('-'))
151        enddo
152        ntot(ii)=nlogged
153        irate(ii)=0
154        if(iseq.gt.0) irate(ii)=nint(nlogged*3600.0/(15*iseq))
155        write(*,1030) nsig,fail,nlogged,nc
1561030    format(/'Nsig:',i3,'   Fail:',f4.1,'   Logged QSOs:',i4,      &
157             '   Final nc:',i4)
158     enddo
159
160! Write the summary file
161     write(13,1100) fail,ntot,irate
1621100 format(f4.1,2x,5i6,5x,5i6)
163  enddo
164
165999 end program fox_sim
166