1subroutine multimode_decoder(ss,id2,params,nfsample) 2 3!$ use omp_lib 4 use prog_args 5 use timer_module, only: timer 6 use jt4_decode 7 use jt65_decode 8 use jt9_decode 9 use ft8_decode 10 use ft4_decode 11 use fst4_decode 12 use q65_decode 13 14 include 'jt9com.f90' 15 include 'timer_common.inc' 16 17 type, extends(jt4_decoder) :: counting_jt4_decoder 18 integer :: decoded 19 end type counting_jt4_decoder 20 21 type, extends(jt65_decoder) :: counting_jt65_decoder 22 integer :: decoded 23 end type counting_jt65_decoder 24 25 type, extends(jt9_decoder) :: counting_jt9_decoder 26 integer :: decoded 27 end type counting_jt9_decoder 28 29 type, extends(ft8_decoder) :: counting_ft8_decoder 30 integer :: decoded 31 end type counting_ft8_decoder 32 33 type, extends(ft4_decoder) :: counting_ft4_decoder 34 integer :: decoded 35 end type counting_ft4_decoder 36 37 type, extends(fst4_decoder) :: counting_fst4_decoder 38 integer :: decoded 39 end type counting_fst4_decoder 40 41 type, extends(q65_decoder) :: counting_q65_decoder 42 integer :: decoded 43 end type counting_q65_decoder 44 45 real ss(184,NSMAX) 46 logical baddata,newdat65,newdat9,single_decode,bVHF,bad0,newdat,ex 47 integer*2 id2(NTMAX*12000) 48 type(params_block) :: params 49 real*4 dd(NTMAX*12000) 50 character(len=20) :: datetime 51 character(len=12) :: mycall, hiscall 52 character(len=6) :: mygrid, hisgrid 53 character*60 line 54 data ndec8/0/,ntr0/-1/ 55 save 56 type(counting_jt4_decoder) :: my_jt4 57 type(counting_jt65_decoder) :: my_jt65 58 type(counting_jt9_decoder) :: my_jt9 59 type(counting_ft8_decoder) :: my_ft8 60 type(counting_ft4_decoder) :: my_ft4 61 type(counting_fst4_decoder) :: my_fst4 62 type(counting_q65_decoder) :: my_q65 63 64 if(.not.params%newdat .and. params%ntr.gt.ntr0) go to 800 65 ntr0=params%ntr 66 rms=sqrt(dot_product(float(id2(1:180000)), & 67 float(id2(1:180000)))/180000.0) 68 if(rms.lt.3.0) go to 800 69 70 !cast C character arrays to Fortran character strings 71 datetime=transfer(params%datetime, datetime) 72 mycall=transfer(params%mycall,mycall) 73 hiscall=transfer(params%hiscall,hiscall) 74 mygrid=transfer(params%mygrid,mygrid) 75 hisgrid=transfer(params%hisgrid,hisgrid) 76 77 ! initialize decode counts 78 my_jt4%decoded = 0 79 my_jt65%decoded = 0 80 my_jt9%decoded = 0 81 my_ft8%decoded = 0 82 my_ft4%decoded = 0 83 my_fst4%decoded = 0 84 my_q65%decoded = 0 85 86! For testing only: return Rx messages stored in a file as decodes 87 inquire(file='rx_messages.txt',exist=ex) 88 if(ex) then 89 if(params%nzhsym.eq.41) then 90 open(39,file='rx_messages.txt',status='old') 91 do i=1,9999 92 read(39,'(a60)',end=5) line 93 if(line(1:1).eq.' ' .or. line(1:1).eq.'-') go to 800 94 write(*,'(a)') trim(line) 95 enddo 965 close(39) 97 endif 98 go to 800 99 endif 100 101 ncontest=iand(params%nexp_decode,7) 102 single_decode=iand(params%nexp_decode,32).ne.0 103 bVHF=iand(params%nexp_decode,64).ne.0 104 if(mod(params%nranera,2).eq.0) ntrials=10**(params%nranera/2) 105 if(mod(params%nranera,2).eq.1) ntrials=3*10**(params%nranera/2) 106 if(params%nranera.eq.0) ntrials=0 107 108 nfail=0 10910 if (params%nagain) then 110 open(13,file=trim(temp_dir)//'/decoded.txt',status='unknown', & 111 position='append',iostat=ios) 112 else 113 open(13,file=trim(temp_dir)//'/decoded.txt',status='unknown',iostat=ios) 114 endif 115 if(ios.ne.0) then 116 nfail=nfail+1 117 if(nfail.le.3) then 118 call sleep_msec(10) 119 go to 10 120 endif 121 endif 122 123 if(params%nmode.eq.8) then 124! We're in FT8 mode 125 126 if(ncontest.eq.6) then 127! Fox mode: initialize and open houndcallers.txt 128 inquire(file=trim(temp_dir)//'/houndcallers.txt',exist=ex) 129 if(.not.ex) then 130 c2fox=' ' 131 g2fox=' ' 132 nsnrfox=-99 133 nfreqfox=-99 134 n30z=0 135 nwrap=0 136 nfox=0 137 endif 138 open(19,file=trim(temp_dir)//'/houndcallers.txt',status='unknown') 139 endif 140 141 call timer('decft8 ',0) 142 newdat=params%newdat 143 if(params%emedelay.ne.0.0) then 144 id2(1:156000)=id2(24001:180000) ! Drop the first 2 seconds of data 145 id2(156001:180000)=0 146 endif 147 call my_ft8%decode(ft8_decoded,id2,params%nQSOProgress,params%nfqso, & 148 params%nftx,newdat,params%nutc,params%nfa,params%nfb, & 149 params%nzhsym,params%ndepth,params%emedelay,ncontest, & 150 logical(params%nagain),logical(params%lft8apon), & 151 logical(params%lapcqonly),params%napwid,mycall,hiscall, & 152 params%ndiskdat) 153 call timer('decft8 ',1) 154 if(nfox.gt.0) then 155 n30min=minval(n30fox(1:nfox)) 156 n30max=maxval(n30fox(1:nfox)) 157 endif 158 j=0 159 160 if(ncontest.eq.6) then 161! Fox mode: save decoded Hound calls for possible selection by FoxOp 162 rewind 19 163 if(nfox.eq.0) then 164 endfile 19 165 rewind 19 166 else 167 do i=1,nfox 168 n=n30fox(i) 169 if(n30max-n30fox(i).le.4) then 170 j=j+1 171 c2fox(j)=c2fox(i) 172 g2fox(j)=g2fox(i) 173 nsnrfox(j)=nsnrfox(i) 174 nfreqfox(j)=nfreqfox(i) 175 n30fox(j)=n 176 m=n30max-n 177 if(len(trim(g2fox(j))).eq.4) then 178 call azdist(mygrid,g2fox(j)//' ',0.d0,nAz,nEl,nDmiles, & 179 nDkm,nHotAz,nHotABetter) 180 else 181 nDkm=9999 182 endif 183 write(19,1004) c2fox(j),g2fox(j),nsnrfox(j),nfreqfox(j),nDkm,m 1841004 format(a12,1x,a4,i5,i6,i7,i3) 185 endif 186 enddo 187 nfox=j 188 flush(19) 189 endif 190 endif 191 go to 800 192 endif 193 194 if(params%nmode.eq.5) then 195 call timer('decft4 ',0) 196 call my_ft4%decode(ft4_decoded,id2,params%nQSOProgress,params%nfqso, & 197 params%nfa,params%nfb,params%ndepth, & 198 logical(params%lapcqonly),ncontest,mycall,hiscall) 199 call timer('decft4 ',1) 200 go to 800 201 endif 202 203 if(params%nmode.eq.66) then !NB: JT65 = 65, Q65 = 66. 204! We're in Q65 mode 205 open(17,file=trim(temp_dir)//'/red.dat',status='unknown') 206 open(14,file=trim(temp_dir)//'/avemsg.txt',status='unknown') 207 call timer('dec_q65 ',0) 208 nqd=1 209 call my_q65%decode(q65_decoded,id2,nqd,params%nutc,params%ntr, & 210 params%nsubmode,params%nfqso,params%ntol,params%ndepth, & 211 params%nfa,params%nfb,logical(params%nclearave), & 212 single_decode,logical(params%nagain),params%max_drift, & 213 logical(params%newdat),params%emedelay,mycall,hiscall,hisgrid, & 214 params%nQSOProgress,ncontest,logical(params%lapcqonly),navg0) 215 call timer('dec_q65 ',1) 216 close(17) 217 go to 800 218 endif 219 220 if(params%nmode.eq.240) then 221! We're in FST4 mode 222 ndepth=iand(params%ndepth,3) 223 iwspr=0 224 params%nsubmode=0 225 call timer('dec_fst4',0) 226 call my_fst4%decode(fst4_decoded,id2,params%nutc, & 227 params%nQSOProgress,params%nfa,params%nfb, & 228 params%nfqso,ndepth,params%ntr,params%nexp_decode, & 229 params%ntol,params%emedelay,logical(params%nagain), & 230 logical(params%lapcqonly),mycall,hiscall,iwspr) 231 call timer('dec_fst4',1) 232 go to 800 233 endif 234 235 if(params%nmode.eq.241) then 236! We're in FST4W mode 237 ndepth=iand(params%ndepth,3) 238 iwspr=1 239 call timer('dec_fst4',0) 240 call my_fst4%decode(fst4_decoded,id2,params%nutc, & 241 params%nQSOProgress,params%nfa,params%nfb, & 242 params%nfqso,ndepth,params%ntr,params%nexp_decode, & 243 params%ntol,params%emedelay,logical(params%nagain), & 244 logical(params%lapcqonly),mycall,hiscall,iwspr) 245 call timer('dec_fst4',1) 246 go to 800 247 endif 248 249! Zap data at start that might come from T/R switching transient? 250 nadd=100 251 k=0 252 bad0=.false. 253 do i=1,240 254 sq=0. 255 do n=1,nadd 256 k=k+1 257 sq=sq + float(id2(k))**2 258 enddo 259 rms=sqrt(sq/nadd) 260 if(rms.gt.10000.0) then 261 bad0=.true. 262 kbad=k 263 rmsbad=rms 264 endif 265 enddo 266 if(bad0) then 267 nz=min(NTMAX*12000,kbad+100) 268! id2(1:nz)=0 ! temporarily disabled as it can breaak the JT9 decoder, maybe others 269 endif 270 271 if(params%nmode.eq.4 .or. params%nmode.eq.65) open(14,file=trim(temp_dir)// & 272 '/avemsg.txt',status='unknown') 273 274 if(params%nmode.eq.4) then 275 jz=52*nfsample 276 if(params%newdat) then 277 if(nfsample.eq.12000) call wav11(id2,jz,dd) 278 if(nfsample.eq.11025) dd(1:jz)=id2(1:jz) 279 else 280 jz=52*11025 281 endif 282 call my_jt4%decode(jt4_decoded,dd,jz,params%nutc,params%nfqso, & 283 params%ntol,params%emedelay,params%dttol,logical(params%nagain), & 284 params%ndepth,logical(params%nclearave),params%minsync, & 285 params%minw,params%nsubmode,mycall,hiscall, & 286 hisgrid,params%nlist,params%listutc,jt4_average) 287 go to 800 288 endif 289 290 npts65=52*12000 291 if(baddata(id2,npts65)) then 292 nsynced=0 293 ndecoded=0 294 go to 800 295 endif 296 297 ntol65=params%ntol !### is this OK? ### 298 newdat65=params%newdat 299 newdat9=params%newdat 300 301!$call omp_set_dynamic(.true.) 302!$omp parallel sections num_threads(2) copyin(/timer_private/) shared(ndecoded) if(.true.) !iif() needed on Mac 303 304!$omp section 305 if(params%nmode.eq.65) then 306! We're in JT65 mode 307 308 if(newdat65) dd(1:npts65)=id2(1:npts65) 309 nf1=params%nfa 310 nf2=params%nfb 311 call timer('jt65a ',0) 312 call my_jt65%decode(jt65_decoded,dd,npts65,newdat65,params%nutc, & 313 nf1,nf2,params%nfqso,ntol65,params%nsubmode,params%minsync, & 314 logical(params%nagain),params%n2pass,logical(params%nrobust), & 315 ntrials,params%naggressive,params%ndepth,params%emedelay, & 316 logical(params%nclearave),mycall,hiscall, & 317 hisgrid,params%nexp_decode,params%nQSOProgress, & 318 logical(params%ljt65apon)) 319 call timer('jt65a ',1) 320 321 else if(params%nmode.eq.9 .or. (params%nmode.eq.(65+9) .and. params%ntxmode.eq.9)) then 322! We're in JT9 mode, or should do JT9 first 323 call timer('decjt9 ',0) 324 call my_jt9%decode(jt9_decoded,ss,id2,params%nfqso, & 325 newdat9,params%npts8,params%nfa,params%nfsplit,params%nfb, & 326 params%ntol,params%nzhsym,logical(params%nagain),params%ndepth, & 327 params%nmode,params%nsubmode,params%nexp_decode) 328 call timer('decjt9 ',1) 329 endif 330 331!$omp section 332 if(params%nmode.eq.(65+9)) then !Do the other mode (we're in dual mode) 333 if (params%ntxmode.eq.9) then 334 if(newdat65) dd(1:npts65)=id2(1:npts65) 335 nf1=params%nfa 336 nf2=params%nfb 337 call timer('jt65a ',0) 338 call my_jt65%decode(jt65_decoded,dd,npts65,newdat65,params%nutc, & 339 nf1,nf2,params%nfqso,ntol65,params%nsubmode,params%minsync, & 340 logical(params%nagain),params%n2pass,logical(params%nrobust), & 341 ntrials,params%naggressive,params%ndepth,params%emedelay, & 342 logical(params%nclearave),mycall,hiscall, & 343 hisgrid,params%nexp_decode,params%nQSOProgress, & 344 logical(params%ljt65apon)) 345 call timer('jt65a ',1) 346 else 347 call timer('decjt9 ',0) 348 call my_jt9%decode(jt9_decoded,ss,id2,params%nfqso, & 349 newdat9,params%npts8,params%nfa,params%nfsplit,params%nfb, & 350 params%ntol,params%nzhsym,logical(params%nagain), & 351 params%ndepth,params%nmode,params%nsubmode,params%nexp_decode) 352 call timer('decjt9 ',1) 353 end if 354 endif 355 356!$omp end parallel sections 357 358! JT65 is not yet producing info for nsynced, ndecoded. 359800 ndecoded = my_jt4%decoded + my_jt65%decoded + my_jt9%decoded + & 360 my_ft8%decoded + my_ft4%decoded + my_fst4%decoded + & 361 my_q65%decoded 362 if(params%nmode.eq.8 .and. params%nzhsym.eq.41) ndec41=ndecoded 363 if(params%nmode.eq.8 .and. params%nzhsym.eq.47) ndec47=ndecoded 364 if(params%nmode.eq.8 .and. params%nzhsym.eq.50) then 365 ndecoded=ndec41+ndec47+ndecoded 366 endif 367 if(params%nmode.ne.8 .or. params%nzhsym.eq.50 .or. & 368 .not.params%ndiskdat) then 369 370 write(*,1010) nsynced,ndecoded,navg0 3711010 format('<DecodeFinished>',2i4,i9) 372 call flush(6) 373 endif 374 close(13) 375 if(ncontest.eq.6) close(19) 376 if(params%nmode.eq.4 .or. params%nmode.eq.65 .or. params%nmode.eq.66) close(14) 377 return 378contains 379 380 subroutine jt4_decoded(this,snr,dt,freq,have_sync,sync,is_deep, & 381 decoded0,qual,ich,is_average,ave) 382 implicit none 383 class(jt4_decoder), intent(inout) :: this 384 integer, intent(in) :: snr 385 real, intent(in) :: dt 386 integer, intent(in) :: freq 387 logical, intent(in) :: have_sync 388 logical, intent(in) :: is_deep 389 character(len=1), intent(in) :: sync 390 character(len=22), intent(in) :: decoded0 391 real, intent(in) :: qual 392 integer, intent(in) :: ich 393 logical, intent(in) :: is_average 394 integer, intent(in) :: ave 395 396 character*22 decoded 397 character*3 cflags 398 399 if(ich.eq.-99) stop !Silence compiler warning 400 if (have_sync) then 401 decoded=decoded0 402 cflags=' ' 403 if(decoded.ne.' ') then 404 cflags='f ' 405 if(is_deep) then 406 cflags='d ' 407 write(cflags(2:2),'(i1)') min(int(qual),9) 408 if(qual.ge.10.0) cflags(2:2)='*' 409 if(qual.lt.3.0) decoded(22:22)='?' 410 endif 411 if(is_average) then 412 write(cflags(3:3),'(i1)') min(ave,9) 413 if(ave.ge.10) cflags(3:3)='*' 414 if(cflags(1:1).eq.'f') cflags=cflags(1:1)//cflags(3:3)//' ' 415 endif 416 endif 417 write(*,1000) params%nutc,snr,dt,freq,sync,decoded,cflags 4181000 format(i4.4,i4,f5.1,i5,1x,'$',a1,1x,a22,1x,a3) 419 else 420 write(*,1000) params%nutc,snr,dt,freq 421 end if 422 423 select type(this) 424 type is (counting_jt4_decoder) 425 this%decoded = this%decoded + 1 426 end select 427 end subroutine jt4_decoded 428 429 subroutine jt4_average (this, used, utc, sync, dt, freq, flip) 430 implicit none 431 class(jt4_decoder), intent(inout) :: this 432 logical, intent(in) :: used 433 integer, intent(in) :: utc 434 real, intent(in) :: sync 435 real, intent(in) :: dt 436 integer, intent(in) :: freq 437 logical, intent(in) :: flip 438 character(len=1) :: cused, csync 439 440 cused = '.' 441 csync = '*' 442 if (used) cused = '$' 443 if (flip) csync = '$' 444 write(14,1000) cused,utc,sync,dt,freq,csync 4451000 format(a1,i5.4,f6.1,f6.2,i6,1x,a1) 446 end subroutine jt4_average 447 448 subroutine jt65_decoded(this,sync,snr,dt,freq,drift,nflip,width, & 449 decoded0,ft,qual,nsmo,nsum,minsync) 450 451 use jt65_decode 452 implicit none 453 454 class(jt65_decoder), intent(inout) :: this 455 real, intent(in) :: sync 456 integer, intent(in) :: snr 457 real, intent(in) :: dt 458 integer, intent(in) :: freq 459 integer, intent(in) :: drift 460 integer, intent(in) :: nflip 461 real, intent(in) :: width 462 character(len=22), intent(in) :: decoded0 463 integer, intent(in) :: ft 464 integer, intent(in) :: qual 465 integer, intent(in) :: nsmo 466 integer, intent(in) :: nsum 467 integer, intent(in) :: minsync 468 469 integer i,nap 470 logical is_deep,is_average 471 character decoded*22,csync*2,cflags*3 472 473 if(width.eq.-9999.0) stop !Silence compiler warning 474!$omp critical(decode_results) 475 decoded=decoded0 476 cflags=' ' 477 is_deep=ft.eq.2 478 479 if(ft.eq.0 .and. minsync.ge.0 .and. int(sync).lt.minsync) then 480 write(*,1010) params%nutc,snr,dt,freq 481 else 482 is_average=nsum.ge.2 483 if(bVHF .and. ft.gt.0) then 484 cflags='f ' 485 if(is_deep) then 486 cflags='d ' 487 write(cflags(2:2),'(i1)') min(qual,9) 488 if(qual.ge.10) cflags(2:2)='*' 489 if(qual.lt.3) decoded(22:22)='?' 490 endif 491 if(is_average) then 492 write(cflags(3:3),'(i1)') min(nsum,9) 493 if(nsum.ge.10) cflags(3:3)='*' 494 endif 495 nap=ishft(ft,-2) 496 if(nap.ne.0) then 497 if(nsum.lt.2) write(cflags(1:3),'(a1,i1," ")') 'a',nap 498 if(nsum.ge.2) write(cflags(1:3),'(a1,2i1)') 'a',nap,min(nsum,9) 499 endif 500 endif 501 csync='# ' 502 i=0 503 if(bVHF .and. nflip.ne.0 .and. & 504 sync.ge.max(0.0,float(minsync))) then 505 csync='#*' 506 if(nflip.eq.-1) then 507 csync='##' 508 if(decoded.ne.' ') then 509 do i=22,1,-1 510 if(decoded(i:i).ne.' ') exit 511 enddo 512 if(i.gt.18) i=18 513 decoded(i+2:i+4)='OOO' 514 endif 515 endif 516 endif 517 n=len(trim(decoded)) 518 if(n.eq.2 .or. n.eq.3) csync='# ' 519 if(cflags(1:1).eq.'f') then 520 cflags(2:2)=cflags(3:3) 521 cflags(3:3)=' ' 522 endif 523 write(*,1010) params%nutc,snr,dt,freq,csync,decoded,cflags 5241010 format(i4.4,i4,f5.1,i5,1x,a2,1x,a22,1x,a3) 525 endif 526 write(13,1012) params%nutc,nint(sync),snr,dt,float(freq),drift, & 527 decoded,ft,nsum,nsmo 5281012 format(i4.4,i4,i5,f6.2,f8.0,i4,3x,a22,' JT65',3i3) 529 call flush(6) 530 531!$omp end critical(decode_results) 532 select type(this) 533 type is (counting_jt65_decoder) 534 this%decoded = this%decoded + 1 535 end select 536 end subroutine jt65_decoded 537 538 subroutine jt9_decoded (this, sync, snr, dt, freq, drift, decoded) 539 use jt9_decode 540 implicit none 541 542 class(jt9_decoder), intent(inout) :: this 543 real, intent(in) :: sync 544 integer, intent(in) :: snr 545 real, intent(in) :: dt 546 real, intent(in) :: freq 547 integer, intent(in) :: drift 548 character(len=22), intent(in) :: decoded 549 550 !$omp critical(decode_results) 551 write(*,1000) params%nutc,snr,dt,nint(freq),decoded 5521000 format(i4.4,i4,f5.1,i5,1x,'@ ',1x,a22) 553 write(13,1002) params%nutc,nint(sync),snr,dt,freq,drift,decoded 5541002 format(i4.4,i4,i5,f6.1,f8.0,i4,3x,a22,' JT9') 555 call flush(6) 556 !$omp end critical(decode_results) 557 select type(this) 558 type is (counting_jt9_decoder) 559 this%decoded = this%decoded + 1 560 end select 561 end subroutine jt9_decoded 562 563 subroutine ft8_decoded (this,sync,snr,dt,freq,decoded,nap,qual) 564 use ft8_decode 565 implicit none 566 567 class(ft8_decoder), intent(inout) :: this 568 real, intent(in) :: sync 569 integer, intent(in) :: snr 570 real, intent(in) :: dt 571 real, intent(in) :: freq 572 character(len=37), intent(in) :: decoded 573 character c1*12,c2*12,g2*4,w*4 574 integer i0,i1,i2,i3,i4,i5,n30,nwrap 575 integer, intent(in) :: nap 576 real, intent(in) :: qual 577 character*2 annot 578 character*37 decoded0 579 logical isgrid4,first,b0,b1,b2 580 data first/.true./ 581 save 582 583 isgrid4(w)=(len_trim(w).eq.4 .and. & 584 ichar(w(1:1)).ge.ichar('A') .and. ichar(w(1:1)).le.ichar('R') .and. & 585 ichar(w(2:2)).ge.ichar('A') .and. ichar(w(2:2)).le.ichar('R') .and. & 586 ichar(w(3:3)).ge.ichar('0') .and. ichar(w(3:3)).le.ichar('9') .and. & 587 ichar(w(4:4)).ge.ichar('0') .and. ichar(w(4:4)).le.ichar('9')) 588 589 if(first) then 590 c2fox=' ' 591 g2fox=' ' 592 nsnrfox=-99 593 nfreqfox=-99 594 n30z=0 595 nwrap=0 596 nfox=0 597 first=.false. 598 endif 599 600 decoded0=decoded 601 602 annot=' ' 603 if(nap.ne.0) then 604 write(annot,'(a1,i1)') 'a',nap 605 if(qual.lt.0.17) decoded0(37:37)='?' 606 endif 607 608! i0=index(decoded0,';') 609! Always print 37 characters? Or, send i3,n3 up to here from ft8b_2 and use them 610! to decide how many chars to print? 611!TEMP 612 i0=1 613 if(i0.le.0) write(*,1000) params%nutc,snr,dt,nint(freq),decoded0(1:22),annot 6141000 format(i6.6,i4,f5.1,i5,' ~ ',1x,a22,1x,a2) 615 if(i0.gt.0) write(*,1001) params%nutc,snr,dt,nint(freq),decoded0,annot 6161001 format(i6.6,i4,f5.1,i5,' ~ ',1x,a37,1x,a2) 617 write(13,1002) params%nutc,nint(sync),snr,dt,freq,0,decoded0 6181002 format(i6.6,i4,i5,f6.1,f8.0,i4,3x,a37,' FT8') 619 620 if(ncontest.eq.6) then 621 i1=index(decoded0,' ') 622 i2=i1 + index(decoded0(i1+1:),' ') 623 i3=i2 + index(decoded0(i2+1:),' ') 624 if(i1.ge.3 .and. i2.ge.7 .and. i3.ge.10) then 625 c1=decoded0(1:i1-1)//' ' 626 c2=decoded0(i1+1:i2-1) 627 g2=decoded0(i2+1:i3-1) 628 b0=c1.eq.mycall 629 if(c1(1:3).eq.'DE ' .and. index(c2,'/').ge.2) b0=.true. 630 if(len(trim(c1)).ne.len(trim(mycall))) then 631 i4=index(trim(c1),trim(mycall)) 632 i5=index(trim(mycall),trim(c1)) 633 if(i4.ge.1 .or. i5.ge.1) b0=.true. 634 endif 635 b1=i3-i2.eq.5 .and. isgrid4(g2) 636 b2=i3-i2.eq.1 637 if(b0 .and. (b1.or.b2) .and. nint(freq).ge.1000) then 638 n=params%nutc 639 n30=(3600*(n/10000) + 60*mod((n/100),100) + mod(n,100))/30 640 if(n30.lt.n30z) nwrap=nwrap+5760 !New UTC day, handle the wrap 641 n30z=n30 642 n30=n30+nwrap 643 if(nfox.lt.MAXFOX) nfox=nfox+1 644 c2fox(nfox)=c2 645 g2fox(nfox)=g2 646 nsnrfox(nfox)=snr 647 nfreqfox(nfox)=nint(freq) 648 n30fox(nfox)=n30 649 endif 650 endif 651 endif 652 653 call flush(6) 654 call flush(13) 655 656 select type(this) 657 type is (counting_ft8_decoder) 658 this%decoded = this%decoded + 1 659 end select 660 661 return 662 end subroutine ft8_decoded 663 664 subroutine ft4_decoded (this,sync,snr,dt,freq,decoded,nap,qual) 665 use ft4_decode 666 implicit none 667 668 class(ft4_decoder), intent(inout) :: this 669 real, intent(in) :: sync 670 integer, intent(in) :: snr 671 real, intent(in) :: dt 672 real, intent(in) :: freq 673 character(len=37), intent(in) :: decoded 674 integer, intent(in) :: nap 675 real, intent(in) :: qual 676 character*2 annot 677 character*37 decoded0 678 679 decoded0=decoded 680 681 annot=' ' 682 if(nap.ne.0) then 683 write(annot,'(a1,i1)') 'a',nap 684 if(qual.lt.0.17) decoded0(37:37)='?' 685 endif 686 687 write(*,1001) params%nutc,snr,dt,nint(freq),decoded0,annot 6881001 format(i6.6,i4,f5.1,i5,' + ',1x,a37,1x,a2) 689 write(13,1002) params%nutc,nint(sync),snr,dt,freq,0,decoded0 6901002 format(i6.6,i4,i5,f6.1,f8.0,i4,3x,a37,' FT4') 691 692 call flush(6) 693 call flush(13) 694 695 select type(this) 696 type is (counting_ft4_decoder) 697 this%decoded = this%decoded + 1 698 end select 699 700 return 701 end subroutine ft4_decoded 702 703 subroutine fst4_decoded (this,nutc,sync,nsnr,dt,freq,decoded,nap, & 704 qual,ntrperiod,lwspr,fmid,w50) 705 706 use fst4_decode 707 implicit none 708 709 class(fst4_decoder), intent(inout) :: this 710 integer, intent(in) :: nutc 711 real, intent(in) :: sync 712 integer, intent(in) :: nsnr 713 real, intent(in) :: dt 714 real, intent(in) :: freq 715 character(len=37), intent(in) :: decoded 716 integer, intent(in) :: nap 717 real, intent(in) :: qual 718 integer, intent(in) :: ntrperiod 719 logical, intent(in) :: lwspr 720 real, intent(in) :: fmid 721 real, intent(in) :: w50 722 723 character*2 annot 724 character*37 decoded0 725 character*70 line 726 727 decoded0=decoded 728 annot=' ' 729 if(nap.ne.0) then 730 write(annot,'(a1,i1)') 'a',nap 731 if(qual.lt.0.17) decoded0(37:37)='?' 732 endif 733 734 if(ntrperiod.lt.60) then 735 write(line,1001) nutc,nsnr,dt,nint(freq),decoded0,annot 7361001 format(i6.6,i4,f5.1,i5,' ` ',1x,a37,1x,a2) 737 write(13,1002) nutc,nint(sync),nsnr,dt,freq,0,decoded0 7381002 format(i6.6,i4,i5,f6.1,f8.0,i4,3x,a37,' FST4') 739 else 740 write(line,1003) nutc,nsnr,dt,nint(freq),decoded0,annot 7411003 format(i4.4,i4,f5.1,i5,' ` ',1x,a37,1x,a2,2f7.3) 742 write(13,1004) nutc,nint(sync),nsnr,dt,freq,0,decoded0 7431004 format(i4.4,i4,i5,f6.1,f8.0,i4,3x,a37,' FST4') 744 endif 745 746 if(fmid.ne.-999.0) then 747 if(w50.lt.0.95) write(line(65:70),'(f6.3)') w50 748 if(w50.ge.0.95) write(line(65:70),'(f6.2)') w50 749 endif 750 751 write(*,1005) line 7521005 format(a70) 753 754 call flush(6) 755 call flush(13) 756 757 select type(this) 758 type is (counting_fst4_decoder) 759 this%decoded = this%decoded + 1 760 end select 761 762 return 763 end subroutine fst4_decoded 764 765 subroutine q65_decoded (this,nutc,snr1,nsnr,dt,freq,decoded,idec, & 766 nused,ntrperiod) 767 768 use q65_decode 769 implicit none 770 771 class(q65_decoder), intent(inout) :: this 772 integer, intent(in) :: nutc 773 real, intent(in) :: snr1 774 integer, intent(in) :: nsnr 775 real, intent(in) :: dt 776 real, intent(in) :: freq 777 character(len=37), intent(in) :: decoded 778 integer, intent(in) :: idec 779 integer, intent(in) :: nused 780 integer, intent(in) :: ntrperiod 781 character*3 cflags 782 783 cflags=' ' 784 if(idec.ge.0) then 785 cflags='q ' 786 write(cflags(2:2),'(i1)') idec 787 if(nused.ge.2) write(cflags(3:3),'(i1)') nused 788 endif 789 790 if(ntrperiod.lt.60) then 791 write(*,1001) nutc,nsnr,dt,nint(freq),decoded,cflags 7921001 format(i6.6,i4,f5.1,i5,' : ',1x,a37,1x,a3) 793 write(13,1002) nutc,nint(snr1),nsnr,dt,freq,0,decoded 7941002 format(i6.6,i4,i5,f6.1,f8.0,i4,3x,a37,' Q65') 795 else 796 write(*,1003) nutc,nsnr,dt,nint(freq),decoded,cflags 7971003 format(i4.4,i4,f5.1,i5,' : ',1x,a37,1x,a3) 798 write(13,1004) nutc,nint(snr1),nsnr,dt,freq,0,decoded 7991004 format(i4.4,i4,i5,f6.1,f8.0,i4,3x,a37,' Q65') 800 801 endif 802 call flush(6) 803 call flush(13) 804 805 select type(this) 806 type is (counting_q65_decoder) 807 if(idec.ge.0) this%decoded = this%decoded + 1 808 end select 809 810 return 811 end subroutine q65_decoded 812 813end subroutine multimode_decoder 814