1program psk_parse
2
3  character line*256,callsign*12,callsign0*12,progname*30
4  integer nc(6),ntot(6),nsingle(6)
5  logical zap
6  data callsign0/'            '/
7
8  open(10,file='jt65-2',status='old')
9  nc=0
10  ntot=0
11  ncalls=0
12  nsingle=0
13  zap=.false.
14
15  do iline=1,9999999
16     read(10,'(a256)',end=900) line
17     n=len(trim(line))
18     i1=0
19     i2=0
20     i3=0
21     do i=1,n
22        if(ichar(line(i:i)).eq.9) then
23           if(i1.eq.0) then
24              i1=i
25              cycle
26           endif
27           if(i2.eq.0) then
28              i2=i
29              cycle
30           endif
31           if(i3.eq.0) then
32              i3=i
33              exit
34           endif
35        endif
36     enddo
37     callsign=line(1:i1-1)
38
39     if(zap) then
40        if(callsign(1:1).ge.'0' .and. callsign(1:1).le.'9' .and.               &
41           callsign(2:2).ge.'0' .and. callsign(2:2).le.'9' .and.               &
42           callsign(3:3).ge.'0' .and. callsign(3:3).le.'9') cycle
43
44        if(callsign(1:1).ge.'A' .and. callsign(1:1).le.'Z' .and.               &
45           callsign(2:2).ge.'A' .and. callsign(2:2).le.'Z' .and.               &
46           callsign(3:3).ge.'A' .and. callsign(3:3).le.'Z' .and.               &
47           callsign(4:4).ge.'A' .and. callsign(4:4).le.'Z') cycle
48
49        if(callsign(1:1).eq.'N' .and.                                        &
50           callsign(2:2).ge.'0' .and. callsign(2:2).le.'9' .and.               &
51           callsign(3:3).ge.'0' .and. callsign(3:3).le.'9') cycle
52
53     endif
54
55     progname=line(i1+1:i2-1)
56     do i=1,len(trim(progname))
57        if(progname(i:i).eq.' ') progname(i:i)='_'
58     enddo
59     read(line(i2+1:i3-1),*) ndecodes
60     read(line(i3+1:),*) nreporters
61
62     j=6
63     if(index(progname,'WSJT-X').gt.0) j=1
64     if(index(progname,'HB9HQX').gt.0) j=2
65     if(index(progname,'JTDX').gt.0) j=3
66     if(index(progname,'Comfort').gt.0) j=4
67     if(index(progname,'COMFORT').gt.0) j=4
68     if(index(progname,'JT65-HF').gt.0 .and. j.eq.6) j=5
69
70     nctot=sum(nc)
71     if(callsign.ne.callsign0 .and. nctot.gt.0) then
72        write(13,1000) callsign0,nc,nctot
731000    format(a12,6i8,i10)
74        if(nctot.eq.1) nsingle(j)=nsingle(j)+1
75        nc=0
76        callsign0=callsign
77        ncalls=ncalls+1
78     endif
79     nc(j)=nc(j) + ndecodes
80     ntot(j)=ntot(j) + ndecodes
81     write(12,1010) iline,callsign,ndecodes,nreporters,progname
821010 format(i8,2x,a12,2x,2i8,2x,a30)
83  enddo
84
85900 nctot=sum(nc)
86  if(nctot.gt.0) write(13,1000) callsign0,nc,nctot
87
88  write(*,1018)
891018 format('   Total    WSJT-X  HB9HQX   JTDX  Comfort JT65-HF   Other'/  &
90            '----------------------------------------------------------')
91  write(*,1019)
921019 format('Spots reported; fraction of total:')
93  write(*,1020) sum(ntot),ntot
941020 format(i8,2x,6i8)
95  fac=1.0/sum(ntot)
96  write(*,1030) 1.0000,fac*ntot
971030 format(f8.4,2x,6f8.4,f10.4)
98
99  write(*,1038)
1001038 format(/'Singletons; as fraction of spots by same program')
101  write(*,1040) sum(nsingle),nsingle
1021040 format(i8,2x,6i8)
103  write(*,1030) float(sum(nsingle))/sum(ntot),float(nsingle)/ntot
104
105  write(*,1050) ncalls
1061050 format(/'Distinct calls spotted:',i6)
107
108end program psk_parse
109