1module ft8_decode 2 3 parameter (MAXFOX=1000) 4 character*12 c2fox(MAXFOX) 5 character*4 g2fox(MAXFOX) 6 integer nsnrfox(MAXFOX) 7 integer nfreqfox(MAXFOX) 8 integer n30fox(MAXFOX) 9 integer n30z 10 integer nfox 11 12 type :: ft8_decoder 13 procedure(ft8_decode_callback), pointer :: callback 14 contains 15 procedure :: decode 16 end type ft8_decoder 17 18 abstract interface 19 subroutine ft8_decode_callback (this,sync,snr,dt,freq,decoded,nap,qual) 20 import ft8_decoder 21 implicit none 22 class(ft8_decoder), intent(inout) :: this 23 real, intent(in) :: sync 24 integer, intent(in) :: snr 25 real, intent(in) :: dt 26 real, intent(in) :: freq 27 character(len=37), intent(in) :: decoded 28 integer, intent(in) :: nap 29 real, intent(in) :: qual 30 end subroutine ft8_decode_callback 31 end interface 32 33contains 34 35 subroutine decode(this,callback,iwave,nQSOProgress,nfqso,nftx,newdat, & 36 nutc,nfa,nfb,nzhsym,ndepth,emedelay,ncontest,nagain,lft8apon, & 37 lapcqonly,napwid,mycall12,hiscall12,ldiskdat) 38 use iso_c_binding, only: c_bool, c_int 39 use timer_module, only: timer 40 use shmem, only: shmem_lock, shmem_unlock 41 42 include 'ft8/ft8_params.f90' 43 44 class(ft8_decoder), intent(inout) :: this 45 procedure(ft8_decode_callback) :: callback 46 parameter (MAXCAND=300,MAX_EARLY=100) 47 real*8 tsec,tseq 48 real s(NH1,NHSYM) 49 real sbase(NH1) 50 real candidate(3,MAXCAND) 51 real dd(15*12000),dd1(15*12000) 52 logical, intent(in) :: lft8apon,lapcqonly,nagain 53 logical newdat,lsubtract,ldupe,lrefinedt 54 logical*1 ldiskdat 55 logical lsubtracted(MAX_EARLY) 56 character*12 mycall12,hiscall12 57 integer*2 iwave(15*12000) 58 integer apsym2(58),aph10(10) 59 character datetime*13,msg37*37 60 character*37 allmessages(100) 61 character*12 ctime 62 integer allsnrs(100) 63 integer itone(NN) 64 integer itone_save(NN,MAX_EARLY) 65 real f1_save(MAX_EARLY) 66 real xdt_save(MAX_EARLY) 67 68 save s,dd,dd1,ndec_early,itone_save,f1_save,xdt_save,lsubtracted,allmessages 69 70 this%callback => callback 71 write(datetime,1001) nutc !### TEMPORARY ### 721001 format("000000_",i6.6) 73 74 if(ndepth.eq.1 .and. nzhsym.lt.50) then 75 ndec_early=0 76 return 77 endif 78 if(ndepth.eq.1 .and. nzhsym.eq.50) then 79 dd=iwave 80 endif 81 82 call ft8apset(mycall12,hiscall12,ncontest,apsym2,aph10) 83 84 if(nzhsym.le.47) then 85 dd=iwave 86 dd1=dd 87 endif 88 if(nzhsym.eq.41) then 89 ndecodes=0 90 allmessages=' ' 91 allsnrs=0 92 else 93 ndecodes=ndec_early 94 endif 95 if(nzhsym.eq.47 .and. ndec_early.eq.0) then 96 dd1=dd 97 go to 800 98 endif 99 if(nzhsym.eq.47 .and. ndec_early.ge.1) then 100 lsubtracted=.false. 101 lrefinedt=.true. 102 if(ndepth.le.2) lrefinedt=.false. 103 call timer('sub_ft8b',0) 104 do i=1,ndec_early 105 if(xdt_save(i)-0.5.lt.0.396) then 106 call subtractft8(dd,itone_save(1,i),f1_save(i),xdt_save(i), & 107 lrefinedt) 108 lsubtracted(i)=.true. 109 endif 110 call timestamp(tsec,tseq,ctime) 111 if(.not.ldiskdat .and. tseq.ge.14.3d0) then !Bail out before done 112 call timer('sub_ft8b',1) 113 dd1=dd 114 go to 800 115 endif 116 enddo 117 call timer('sub_ft8b',1) 118 dd1=dd 119 go to 900 120 endif 121 if(nzhsym.eq.50 .and. ndec_early.ge.1 .and. .not.nagain) then 122 n=47*3456 123 dd(1:n)=dd1(1:n) 124 dd(n+1:)=iwave(n+1:) 125 call timer('sub_ft8c',0) 126 do i=1,ndec_early 127 if(lsubtracted(i)) cycle 128 call subtractft8(dd,itone_save(1,i),f1_save(i),xdt_save(i),.true.) 129 enddo 130 call timer('sub_ft8c',1) 131 endif 132 ifa=nfa 133 ifb=nfb 134 if(nzhsym.eq.50 .and. nagain) then 135 dd=iwave 136 ifa=nfqso-20 137 ifb=nfqso+20 138 endif 139 140! For now: 141! ndepth=1: 1 pass, bp 142! ndepth=2: subtraction, 3 passes, bp+osd (no subtract refinement) 143! ndepth=3: subtraction, 3 passes, bp+osd 144 npass=3 145 if(ndepth.eq.1) npass=1 146 do ipass=1,npass 147 newdat=.true. 148 syncmin=1.3 149 if(ndepth.le.2) syncmin=1.6 150 if(ipass.eq.1) then 151 lsubtract=.true. 152 ndeep=ndepth 153 if(ndepth.eq.3) ndeep=2 154 elseif(ipass.eq.2) then 155 n2=ndecodes 156 if(ndecodes.eq.0) cycle 157 lsubtract=.true. 158 ndeep=ndepth 159 elseif(ipass.eq.3) then 160 if((ndecodes-n2).eq.0) cycle 161 lsubtract=.true. 162 ndeep=ndepth 163 endif 164 call timer('sync8 ',0) 165 maxc=MAXCAND 166 call sync8(dd,ifa,ifb,syncmin,nfqso,maxc,s,candidate, & 167 ncand,sbase) 168 call timer('sync8 ',1) 169 do icand=1,ncand 170 sync=candidate(3,icand) 171 f1=candidate(1,icand) 172 xdt=candidate(2,icand) 173 xbase=10.0**(0.1*(sbase(nint(f1/3.125))-40.0)) 174 msg37=' ' 175 call timer('ft8b ',0) 176 call ft8b(dd,newdat,nQSOProgress,nfqso,nftx,ndeep,nzhsym,lft8apon, & 177 lapcqonly,napwid,lsubtract,nagain,ncontest,iaptype,mycall12, & 178 hiscall12,f1,xdt,xbase,apsym2,aph10,nharderrors,dmin, & 179 nbadcrc,iappass,msg37,xsnr,itone) 180 call timer('ft8b ',1) 181 nsnr=nint(xsnr) 182 xdt=xdt-0.5 183 hd=nharderrors+dmin 184 if(nbadcrc.eq.0) then 185 ldupe=.false. 186 do id=1,ndecodes 187 if(msg37.eq.allmessages(id)) ldupe=.true. 188 enddo 189 if(.not.ldupe) then 190 ndecodes=ndecodes+1 191 allmessages(ndecodes)=msg37 192 allsnrs(ndecodes)=nsnr 193 f1_save(ndecodes)=f1 194 xdt_save(ndecodes)=xdt+0.5 195 itone_save(1:NN,ndecodes)=itone 196 endif 197 if(.not.ldupe .and. associated(this%callback)) then 198 qual=1.0-(nharderrors+dmin)/60.0 ! scale qual to [0.0,1.0] 199 if(emedelay.ne.0) xdt=xdt+2.0 200 call this%callback(sync,nsnr,xdt,f1,msg37,iaptype,qual) 201 endif 202 endif 203 call timestamp(tsec,tseq,ctime) 204 if(.not.ldiskdat .and. nzhsym.eq.41 .and. & 205 tseq.ge.13.4d0) go to 800 !Bail out before done 206 enddo ! icand 207 enddo ! ipass 208 209800 ndec_early=0 210 if(nzhsym.lt.50) ndec_early=ndecodes 211 212900 return 213end subroutine decode 214 215subroutine timestamp(tsec,tseq,ctime) 216 real*8 tsec,tseq 217 character*12 ctime 218 integer itime(8) 219 call date_and_time(values=itime) 220 tsec=3600.d0*(itime(5)-itime(4)/60.d0) + 60.d0*itime(6) + & 221 itime(7) + 0.001d0*itime(8) 222 tsec=mod(tsec+2*86400.d0,86400.d0) 223 tseq=mod(itime(7)+0.001d0*itime(8),15.d0) 224 if(tseq.lt.10.d0) tseq=tseq+15.d0 225 sec=itime(7)+0.001*itime(8) 226 write(ctime,1000) itime(5)-itime(4)/60,itime(6),sec 2271000 format(i2.2,':',i2.2,':',f6.3) 228 if(ctime(7:7).eq.' ') ctime(7:7)='0' 229 return 230end subroutine timestamp 231 232end module ft8_decode 233