2020-02-13 15:05:37 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,nzhsym,lapon,     &
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     lapcqonly,napwid,lsubtract,nagain,ncontest,iaptype,mycall12,hiscall12, &
							 | 
						
					
						
							
								
									
										
										
										
											2020-03-19 11:27:57 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     f1,xdt,xbase,apsym,aph10,nharderrors,dmin,nbadcrc,ipass,               &
							 | 
						
					
						
							
								
									
										
										
										
											2020-02-13 15:05:37 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     msg37,xsnr,itone)
							 | 
						
					
						
							
								
									
										
										
										
											2017-06-19 20:15:43 +00:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2017-12-08 17:03:11 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  use crc
							 | 
						
					
						
							
								
									
										
										
										
											2017-06-30 20:11:07 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  use timer_module, only: timer
							 | 
						
					
						
							
								
									
										
										
										
											2018-07-05 14:07:17 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  use packjt77
							 | 
						
					
						
							
								
									
										
										
										
											2017-06-19 20:15:43 +00:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  include 'ft8_params.f90'
							 | 
						
					
						
							
								
									
										
										
										
											2018-01-30 15:25:10 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  parameter(NP2=2812)
							 | 
						
					
						
							
								
									
										
										
										
											2018-12-05 16:06:33 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  character*37 msg37
							 | 
						
					
						
							
								
									
										
										
										
											2018-12-20 15:08:29 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  character*12 mycall12,hiscall12
							 | 
						
					
						
							
								
									
										
										
										
											2018-07-04 10:15:01 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  character*77 c77
							 | 
						
					
						
							
								
									
										
										
										
											2017-07-01 13:08:30 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  real a(5)
							 | 
						
					
						
							
								
									
										
										
										
											2018-06-26 11:11:58 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  real s8(0:7,NN)
							 | 
						
					
						
							
								
									
										
										
										
											2018-12-16 11:55:36 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  real s2(0:511)
							 | 
						
					
						
							
								
									
										
										
										
											2020-02-17 10:53:52 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  real bmeta(174),bmetb(174),bmetc(174),bmetd(174)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  real llra(174),llrb(174),llrc(174),llrd(174),llrz(174)           !Soft symbols
							 | 
						
					
						
							
								
									
										
										
										
											2017-07-01 13:08:30 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  real dd0(15*12000)
							 | 
						
					
						
							
								
									
										
										
										
											2020-02-29 13:46:59 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  real ss(9)
							 | 
						
					
						
							
								
									
										
										
										
											2020-05-04 13:13:49 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  integer*1 message77(77),message91(91),apmask(174),cw(174)
							 | 
						
					
						
							
								
									
										
										
										
											2020-02-03 10:48:51 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  integer apsym(58),aph10(10)
							 | 
						
					
						
							
								
									
										
										
										
											2020-01-24 11:26:36 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  integer mcq(29),mcqru(29),mcqfd(29),mcqtest(29),mcqww(29)
							 | 
						
					
						
							
								
									
										
										
										
											2018-10-04 16:40:45 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  integer mrrr(19),m73(19),mrr73(19)
							 | 
						
					
						
							
								
									
										
										
										
											2017-07-01 13:08:30 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  integer itone(NN)
							 | 
						
					
						
							
								
									
										
										
										
											2017-07-25 20:55:13 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  integer icos7(0:6),ip(1)
							 | 
						
					
						
							
								
									
										
										
										
											2017-12-18 19:07:10 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  integer nappasses(0:5)  !Number of decoding passes to use for each QSO state
							 | 
						
					
						
							
								
									
										
										
										
											2017-07-27 15:35:40 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  integer naptypes(0:5,4) ! (nQSOProgress, decoding pass)  maximum of 4 passes for now
							 | 
						
					
						
							
								
									
										
										
										
											2018-09-28 14:13:58 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  integer ncontest,ncontest0
							 | 
						
					
						
							
								
									
										
										
										
											2018-06-27 09:55:34 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  logical one(0:511,0:8)
							 | 
						
					
						
							
								
									
										
										
										
											2018-06-25 17:01:34 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  integer graymap(0:7)
							 | 
						
					
						
							
								
									
										
										
										
											2020-02-29 13:46:59 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  integer iloc(1)
							 | 
						
					
						
							
								
									
										
										
										
											2018-06-30 14:56:19 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  complex cd0(0:3199)
							 | 
						
					
						
							
								
									
										
										
										
											2017-07-01 13:08:30 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  complex ctwk(32)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  complex csymb(32)
							 | 
						
					
						
							
								
									
										
										
										
											2018-06-22 11:20:28 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  complex cs(0:7,NN)
							 | 
						
					
						
							
								
									
										
										
										
											2018-09-12 15:06:26 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  logical first,newdat,lsubtract,lapon,lapcqonly,nagain,unpk77_success
							 | 
						
					
						
							
								
									
										
										
										
											2018-06-05 16:37:29 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  data icos7/3,1,4,0,6,5,2/  ! Flipped w.r.t. original FT8 sync array
							 | 
						
					
						
							
								
									
										
										
										
											2018-10-04 16:40:45 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  data     mcq/0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0/
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  data   mcqru/0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,1,1,1,1,0,0,1,1,0,0/
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  data   mcqfd/0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,1,0,0,1,0,0,0,1,0/
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  data mcqtest/0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,1,0,1,0,1,1,1,1,1,1,0,0,1,0/
							 | 
						
					
						
							
								
									
										
										
										
											2020-01-24 11:26:36 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  data   mcqww/0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,1,1,0,1,1,1,1,0/
							 | 
						
					
						
							
								
									
										
										
										
											2018-10-04 16:40:45 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  data    mrrr/0,1,1,1,1,1,1,0,1,0,0,1,0,0,1,0,0,0,1/
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  data     m73/0,1,1,1,1,1,1,0,1,0,0,1,0,1,0,0,0,0,1/
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  data   mrr73/0,1,1,1,1,1,1,0,0,1,1,1,0,1,0,1,0,0,1/
							 | 
						
					
						
							
								
									
										
										
										
											2017-07-27 15:35:40 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  data first/.true./
							 | 
						
					
						
							
								
									
										
										
										
											2018-07-07 08:18:31 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  data graymap/0,1,3,2,5,6,4,7/
							 | 
						
					
						
							
								
									
										
										
										
											2018-12-20 15:08:29 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  save nappasses,naptypes,ncontest0,one
							 | 
						
					
						
							
								
									
										
										
										
											2017-07-27 15:35:40 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2018-09-28 14:13:58 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  if(first.or.(ncontest.ne.ncontest0)) then
							 | 
						
					
						
							
								
									
										
										
										
											2017-07-27 15:35:40 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     mcq=2*mcq-1
							 | 
						
					
						
							
								
									
										
										
										
											2018-10-04 16:40:45 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     mcqfd=2*mcqfd-1
							 | 
						
					
						
							
								
									
										
										
										
											2018-09-28 14:13:58 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     mcqru=2*mcqru-1
							 | 
						
					
						
							
								
									
										
										
										
											2018-10-04 16:40:45 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     mcqtest=2*mcqtest-1
							 | 
						
					
						
							
								
									
										
										
										
											2020-01-24 11:26:36 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     mcqww=2*mcqww-1
							 | 
						
					
						
							
								
									
										
										
										
											2017-07-27 15:35:40 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     mrrr=2*mrrr-1
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     m73=2*m73-1
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     mrr73=2*mrr73-1
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     nappasses(0)=2
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     nappasses(1)=2
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     nappasses(2)=2
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     nappasses(3)=4
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     nappasses(4)=4
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     nappasses(5)=3
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! iaptype
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								!------------------------
							 | 
						
					
						
							
								
									
										
										
										
											2018-07-28 17:32:45 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								!   1        CQ     ???    ???           (29+3=32 ap bits)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								!   2        MyCall ???    ???           (29+3=32 ap bits)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								!   3        MyCall DxCall ???           (58+3=61 ap bits)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								!   4        MyCall DxCall RRR           (77 ap bits)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								!   5        MyCall DxCall 73            (77 ap bits)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								!   6        MyCall DxCall RR73          (77 ap bits)
							 | 
						
					
						
							
								
									
										
										
										
											2017-07-27 15:35:40 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2018-10-02 16:20:22 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     naptypes(0,1:4)=(/1,2,0,0/) ! Tx6 selected (CQ)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     naptypes(1,1:4)=(/2,3,0,0/) ! Tx1
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     naptypes(2,1:4)=(/2,3,0,0/) ! Tx2
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     naptypes(3,1:4)=(/3,4,5,6/) ! Tx3
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     naptypes(4,1:4)=(/3,4,5,6/) ! Tx4
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     naptypes(5,1:4)=(/3,1,2,0/) ! Tx5
							 | 
						
					
						
							
								
									
										
										
										
											2018-06-25 17:01:34 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2018-06-27 09:55:34 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     one=.false.
							 | 
						
					
						
							
								
									
										
										
										
											2018-06-25 17:01:34 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     do i=0,511
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								       do j=0,8
							 | 
						
					
						
							
								
									
										
										
										
											2018-06-27 15:11:39 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								         if(iand(i,2**j).ne.0) one(i,j)=.true.
							 | 
						
					
						
							
								
									
										
										
										
											2018-06-25 17:01:34 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								       enddo
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     enddo
							 | 
						
					
						
							
								
									
										
										
										
											2017-07-27 15:35:40 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     first=.false.
							 | 
						
					
						
							
								
									
										
										
										
											2018-09-28 14:13:58 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     ncontest0=ncontest
							 | 
						
					
						
							
								
									
										
										
										
											2017-07-27 15:35:40 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  endif
							 | 
						
					
						
							
								
									
										
										
										
											2017-07-22 03:01:09 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2020-02-03 10:48:51 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  dxcall13=hiscall12  ! initialize for use in packjt77
							 | 
						
					
						
							
								
									
										
										
										
											2019-01-03 14:02:17 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  mycall13=mycall12
							 | 
						
					
						
							
								
									
										
										
										
											2018-08-29 14:18:56 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2017-07-12 21:49:39 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  max_iterations=30
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  nharderrors=-1
							 | 
						
					
						
							
								
									
										
										
										
											2017-07-06 14:19:39 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  fs2=12000.0/NDOWN
							 | 
						
					
						
							
								
									
										
										
										
											2017-07-06 12:07:17 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  dt2=1.0/fs2
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  twopi=8.0*atan(1.0)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  delfbest=0.
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  ibest=0
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2017-07-01 20:47:59 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  call timer('ft8_down',0)
							 | 
						
					
						
							
								
									
										
										
										
											2017-07-06 12:07:17 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  call ft8_downsample(dd0,newdat,f1,cd0)   !Mix f1 to baseband and downsample
							 | 
						
					
						
							
								
									
										
										
										
											2017-07-01 20:47:59 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  call timer('ft8_down',1)
							 | 
						
					
						
							
								
									
										
										
										
											2017-06-19 20:15:43 +00:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2017-07-27 18:07:54 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  i0=nint((xdt+0.5)*fs2)                   !Initial guess for start of signal
							 | 
						
					
						
							
								
									
										
										
										
											2017-07-01 13:08:30 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  smax=0.0
							 | 
						
					
						
							
								
									
										
										
										
											2020-02-29 13:46:59 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  do idt=i0-10,i0+10                         !Search over +/- one quarter symbol
							 | 
						
					
						
							
								
									
										
										
										
											2018-11-05 11:59:48 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     call sync8d(cd0,idt,ctwk,0,sync)
							 | 
						
					
						
							
								
									
										
										
										
											2017-07-06 12:07:17 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     if(sync.gt.smax) then
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        smax=sync
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        ibest=idt
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     endif
							 | 
						
					
						
							
								
									
										
										
										
											2017-07-01 13:08:30 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  enddo
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2017-07-06 12:07:17 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								! Now peak up in frequency
							 | 
						
					
						
							
								
									
										
										
										
											2017-07-01 13:08:30 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  smax=0.0
							 | 
						
					
						
							
								
									
										
										
										
											2017-07-06 12:07:17 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  do ifr=-5,5                              !Search over +/- 2.5 Hz
							 | 
						
					
						
							
								
									
										
										
										
											2017-07-01 13:08:30 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    delf=ifr*0.5
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    dphi=twopi*delf*dt2
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    phi=0.0
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    do i=1,32
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								      ctwk(i)=cmplx(cos(phi),sin(phi))
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								      phi=mod(phi+dphi,twopi)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    enddo
							 | 
						
					
						
							
								
									
										
										
										
											2020-02-29 13:46:59 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    call sync8d(cd0,ibest,ctwk,1,sync)
							 | 
						
					
						
							
								
									
										
										
										
											2017-07-01 13:08:30 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    if( sync .gt. smax ) then
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								      smax=sync
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								      delfbest=delf
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    endif
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  enddo
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  a=0.0
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  a(1)=-delfbest
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  call twkfreq1(cd0,NP2,fs2,a,cd0)
							 | 
						
					
						
							
								
									
										
										
										
											2017-07-06 12:07:17 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  f1=f1+delfbest                           !Improved estimate of DF
							 | 
						
					
						
							
								
									
										
										
										
											2020-02-29 13:46:59 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  call timer('ft8_down',0)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  call ft8_downsample(dd0,.false.,f1,cd0)   !Mix f1 to baseband and downsample
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  call timer('ft8_down',1)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  smax=0.0
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  do idt=-4,4                         !Search over +/- one quarter symbol
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     call sync8d(cd0,ibest+idt,ctwk,0,sync)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     ss(idt+5)=sync
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  enddo
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  smax=maxval(ss)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  iloc=maxloc(ss)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  ibest=iloc(1)-5+ibest
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  xdt=(ibest-1)*dt2
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  sync=smax
							 | 
						
					
						
							
								
									
										
										
										
											2017-06-19 20:15:43 +00:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2017-06-27 19:44:12 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  do k=1,NN
							 | 
						
					
						
							
								
									
										
										
										
											2017-07-01 13:08:30 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    i1=ibest+(k-1)*32
							 | 
						
					
						
							
								
									
										
										
										
											2017-07-01 13:45:16 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    csymb=cmplx(0.0,0.0)
							 | 
						
					
						
							
								
									
										
										
										
											2018-06-30 14:56:19 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    if( i1.ge.0 .and. i1+31 .le. NP2-1 ) csymb=cd0(i1:i1+31)
							 | 
						
					
						
							
								
									
										
										
										
											2017-07-01 13:08:30 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    call four2a(csymb,32,1,-1,1)
							 | 
						
					
						
							
								
									
										
										
										
											2018-06-26 11:11:58 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    cs(0:7,k)=csymb(1:8)/1e3
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    s8(0:7,k)=abs(csymb(1:8))
							 | 
						
					
						
							
								
									
										
										
										
											2017-07-01 13:08:30 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  enddo  
							 | 
						
					
						
							
								
									
										
										
										
											2017-07-26 13:05:34 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2017-07-25 20:55:13 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								! sync quality check
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  is1=0
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  is2=0
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  is3=0
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  do k=1,7
							 | 
						
					
						
							
								
									
										
										
										
											2018-06-22 11:20:28 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    ip=maxloc(s8(:,k))
							 | 
						
					
						
							
								
									
										
										
										
											2017-07-25 20:55:13 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    if(icos7(k-1).eq.(ip(1)-1)) is1=is1+1
							 | 
						
					
						
							
								
									
										
										
										
											2018-06-22 11:20:28 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    ip=maxloc(s8(:,k+36))
							 | 
						
					
						
							
								
									
										
										
										
											2017-07-25 20:55:13 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    if(icos7(k-1).eq.(ip(1)-1)) is2=is2+1
							 | 
						
					
						
							
								
									
										
										
										
											2018-06-22 11:20:28 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    ip=maxloc(s8(:,k+72))
							 | 
						
					
						
							
								
									
										
										
										
											2017-07-25 20:55:13 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    if(icos7(k-1).eq.(ip(1)-1)) is3=is3+1
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  enddo
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! hard sync sum - max is 21
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  nsync=is1+is2+is3
							 | 
						
					
						
							
								
									
										
										
										
											2020-05-04 10:55:53 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  if(nsync .le. 6) then ! bail out
							 | 
						
					
						
							
								
									
										
										
										
											2017-07-25 20:55:13 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    nbadcrc=1
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    return
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  endif
							 | 
						
					
						
							
								
									
										
										
										
											2017-07-26 13:05:34 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2018-06-26 11:11:58 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  do nsym=1,3
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    nt=2**(3*nsym)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    do ihalf=1,2
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								      do k=1,29,nsym
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        if(ihalf.eq.1) ks=k+7
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        if(ihalf.eq.2) ks=k+43
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        amax=-1.0
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        do i=0,nt-1
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								          i1=i/64
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								          i2=iand(i,63)/8
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								          i3=iand(i,7)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								          if(nsym.eq.1) then
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								            s2(i)=abs(cs(graymap(i3),ks))
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								          elseif(nsym.eq.2) then
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								            s2(i)=abs(cs(graymap(i2),ks)+cs(graymap(i3),ks+1))
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								          elseif(nsym.eq.3) then
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								            s2(i)=abs(cs(graymap(i1),ks)+cs(graymap(i2),ks+1)+cs(graymap(i3),ks+2))
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								          else
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								            print*,"Error - nsym must be 1, 2, or 3."
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								          endif
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        enddo
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        i32=1+(k-1)*3+(ihalf-1)*87
							 | 
						
					
						
							
								
									
										
										
										
											2018-06-27 15:11:39 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        if(nsym.eq.1) ibmax=2 
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        if(nsym.eq.2) ibmax=5 
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        if(nsym.eq.3) ibmax=8 
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        do ib=0,ibmax
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								          bm=maxval(s2(0:nt-1),one(0:nt-1,ibmax-ib)) - &
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								             maxval(s2(0:nt-1),.not.one(0:nt-1,ibmax-ib))
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								          if(i32+ib .gt.174) cycle
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								          if(nsym.eq.1) then
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								            bmeta(i32+ib)=bm
							 | 
						
					
						
							
								
									
										
										
										
											2020-02-17 10:53:52 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								            den=max(maxval(s2(0:nt-1),one(0:nt-1,ibmax-ib)), &
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								                    maxval(s2(0:nt-1),.not.one(0:nt-1,ibmax-ib)))
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								            if(den.gt.0.0) then
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								              cm=bm/den
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								            else ! erase it
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								              cm=0.0
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								            endif
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								            bmetd(i32+ib)=cm
							 | 
						
					
						
							
								
									
										
										
										
											2018-06-27 15:11:39 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								          elseif(nsym.eq.2) then
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								            bmetb(i32+ib)=bm
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								          elseif(nsym.eq.3) then
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								            bmetc(i32+ib)=bm
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								          endif
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        enddo
							 | 
						
					
						
							
								
									
										
										
										
											2018-06-22 11:20:28 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								      enddo
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    enddo
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  enddo
							 | 
						
					
						
							
								
									
										
										
										
											2018-09-28 14:13:58 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  call normalizebmet(bmeta,174)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  call normalizebmet(bmetb,174)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  call normalizebmet(bmetc,174)
							 | 
						
					
						
							
								
									
										
										
										
											2020-02-17 10:53:52 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  call normalizebmet(bmetd,174)
							 | 
						
					
						
							
								
									
										
										
										
											2017-07-15 14:21:18 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2017-09-17 15:34:32 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  scalefac=2.83
							 | 
						
					
						
							
								
									
										
										
										
											2018-06-11 15:10:44 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  llra=scalefac*bmeta
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  llrb=scalefac*bmetb
							 | 
						
					
						
							
								
									
										
										
										
											2018-06-22 11:20:28 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  llrc=scalefac*bmetc
							 | 
						
					
						
							
								
									
										
										
										
											2020-02-17 10:53:52 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  llrd=scalefac*bmetd
							 | 
						
					
						
							
								
									
										
										
										
											2018-06-26 11:11:58 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2018-09-28 14:13:58 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  apmag=maxval(abs(llra))*1.01
							 | 
						
					
						
							
								
									
										
										
										
											2017-07-14 16:02:01 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2017-07-27 15:35:40 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								! pass #
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								!------------------------------
							 | 
						
					
						
							
								
									
										
										
										
											2018-07-28 17:32:45 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								!   1        regular decoding, nsym=1 
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								!   2        regular decoding, nsym=2 
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								!   3        regular decoding, nsym=3 
							 | 
						
					
						
							
								
									
										
										
										
											2020-02-17 10:53:52 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								!   4        regular decoding, nsym=1, bit-by-bit normalized 
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								!   5        ap pass 1, nsym=1
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								!   6        ap pass 2
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								!   7        ap pass 3
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								!   8        ap pass 4
							 | 
						
					
						
							
								
									
										
										
										
											2017-07-27 15:35:40 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2020-01-24 11:26:36 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  if(lapon.or.ncontest.eq.7) then !Hounds always use AP
							 | 
						
					
						
							
								
									
										
										
										
											2017-12-04 00:46:19 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     if(.not.lapcqonly) then
							 | 
						
					
						
							
								
									
										
										
										
											2020-02-17 10:53:52 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        npasses=4+nappasses(nQSOProgress)
							 | 
						
					
						
							
								
									
										
										
										
											2017-12-04 00:46:19 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     else
							 | 
						
					
						
							
								
									
										
										
										
											2020-02-17 10:53:52 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        npasses=5 
							 | 
						
					
						
							
								
									
										
										
										
											2017-12-04 00:46:19 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     endif
							 | 
						
					
						
							
								
									
										
										
										
											2017-07-27 18:07:54 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  else
							 | 
						
					
						
							
								
									
										
										
										
											2020-02-17 10:53:52 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     npasses=4
							 | 
						
					
						
							
								
									
										
										
										
											2017-07-27 18:07:54 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  endif
							 | 
						
					
						
							
								
									
										
										
										
											2020-03-17 08:51:37 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  if(nzhsym.lt.50) npasses=4
							 | 
						
					
						
							
								
									
										
										
										
											2020-02-13 15:05:37 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  
							 | 
						
					
						
							
								
									
										
										
										
											2018-07-28 17:32:45 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  do ipass=1,npasses 
							 | 
						
					
						
							
								
									
										
										
										
											2020-02-17 10:53:52 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     llrz=llra
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     if(ipass.eq.2) llrz=llrb
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     if(ipass.eq.3) llrz=llrc
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     if(ipass.eq.4) llrz=llrd
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     if(ipass.le.4) then
							 | 
						
					
						
							
								
									
										
										
										
											2017-07-27 15:35:40 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        apmask=0
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        iaptype=0
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     endif
							 | 
						
					
						
							
								
									
										
										
										
											2020-02-17 10:53:52 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     if(ipass .gt. 4) then
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        llrz=llra
							 | 
						
					
						
							
								
									
										
										
										
											2018-07-28 17:32:45 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        if(.not.lapcqonly) then
							 | 
						
					
						
							
								
									
										
										
										
											2020-02-17 10:53:52 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								           iaptype=naptypes(nQSOProgress,ipass-4)
							 | 
						
					
						
							
								
									
										
										
										
											2018-07-28 17:32:45 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        else
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								           iaptype=1
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        endif
							 | 
						
					
						
							
								
									
										
										
										
											2018-09-29 09:16:56 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2018-10-02 16:20:22 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								! ncontest=0 : NONE
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								!          1 : NA_VHF
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								!          2 : EU_VHF
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								!          3 : FIELD DAY
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								!          4 : RTTY
							 | 
						
					
						
							
								
									
										
										
										
											2020-01-24 11:26:36 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								!          5 : WW_DIGI 
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								!          6 : FOX
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								!          7 : HOUND
							 | 
						
					
						
							
								
									
										
										
										
											2018-10-04 16:40:45 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								!
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! Conditions that cause us to bail out of AP decoding
							 | 
						
					
						
							
								
									
										
										
										
											2020-01-24 11:26:36 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        if(ncontest.le.5 .and. iaptype.ge.3 .and. (abs(f1-nfqso).gt.napwid .and. abs(f1-nftx).gt.napwid) ) cycle
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        if(ncontest.eq.6) cycle                     ! No AP for Foxes
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        if(ncontest.eq.7.and.f1.gt.950.0) cycle     ! Hounds use AP only for signals below 950 Hz
							 | 
						
					
						
							
								
									
										
										
										
											2018-10-04 16:40:45 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        if(iaptype.ge.2 .and. apsym(1).gt.1) cycle  ! No, or nonstandard, mycall 
							 | 
						
					
						
							
								
									
										
										
										
											2020-02-03 10:48:51 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        if(ncontest.eq.7 .and. iaptype.ge.2 .and. aph10(1).gt.1) cycle
							 | 
						
					
						
							
								
									
										
										
										
											2018-10-04 16:40:45 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        if(iaptype.ge.3 .and. apsym(30).gt.1) cycle ! No, or nonstandard, dxcall
							 | 
						
					
						
							
								
									
										
										
										
											2018-10-02 16:20:22 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2018-10-04 16:40:45 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        if(iaptype.eq.1) then ! CQ or CQ RU or CQ TEST or CQ FD
							 | 
						
					
						
							
								
									
										
										
										
											2018-07-28 17:32:45 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								           apmask=0
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								           apmask(1:29)=1  
							 | 
						
					
						
							
								
									
										
										
										
											2020-02-17 10:53:52 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								           if(ncontest.eq.0) llrz(1:29)=apmag*mcq(1:29)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								           if(ncontest.eq.1) llrz(1:29)=apmag*mcqtest(1:29)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								           if(ncontest.eq.2) llrz(1:29)=apmag*mcqtest(1:29)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								           if(ncontest.eq.3) llrz(1:29)=apmag*mcqfd(1:29)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								           if(ncontest.eq.4) llrz(1:29)=apmag*mcqru(1:29)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								           if(ncontest.eq.5) llrz(1:29)=apmag*mcqww(1:29)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								           if(ncontest.eq.7) llrz(1:29)=apmag*mcq(1:29)
							 | 
						
					
						
							
								
									
										
										
										
											2018-07-28 17:32:45 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								           apmask(75:77)=1 
							 | 
						
					
						
							
								
									
										
										
										
											2020-02-17 10:53:52 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								           llrz(75:76)=apmag*(-1)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								           llrz(77)=apmag*(+1)
							 | 
						
					
						
							
								
									
										
										
										
											2018-07-28 17:32:45 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        endif
							 | 
						
					
						
							
								
									
										
										
										
											2018-09-28 14:13:58 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        if(iaptype.eq.2) then ! MyCall,???,??? 
							 | 
						
					
						
							
								
									
										
										
										
											2018-07-28 17:32:45 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								           apmask=0
							 | 
						
					
						
							
								
									
										
										
										
											2020-01-24 11:26:36 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								           if(ncontest.eq.0.or.ncontest.eq.1.or.ncontest.eq.5) then
							 | 
						
					
						
							
								
									
										
										
										
											2018-09-28 14:13:58 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								              apmask(1:29)=1  
							 | 
						
					
						
							
								
									
										
										
										
											2020-02-17 10:53:52 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								              llrz(1:29)=apmag*apsym(1:29)
							 | 
						
					
						
							
								
									
										
										
										
											2018-09-28 14:13:58 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								              apmask(75:77)=1 
							 | 
						
					
						
							
								
									
										
										
										
											2020-02-17 10:53:52 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								              llrz(75:76)=apmag*(-1)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								              llrz(77)=apmag*(+1)
							 | 
						
					
						
							
								
									
										
										
										
											2018-10-04 16:40:45 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								           else if(ncontest.eq.2) then
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								              apmask(1:28)=1  
							 | 
						
					
						
							
								
									
										
										
										
											2020-02-17 10:53:52 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								              llrz(1:28)=apmag*apsym(1:28)
							 | 
						
					
						
							
								
									
										
										
										
											2018-10-04 16:40:45 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								              apmask(72:74)=1
							 | 
						
					
						
							
								
									
										
										
										
											2020-02-17 10:53:52 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								              llrz(72)=apmag*(-1)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								              llrz(73)=apmag*(+1)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								              llrz(74)=apmag*(-1)
							 | 
						
					
						
							
								
									
										
										
										
											2018-10-04 16:40:45 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								              apmask(75:77)=1 
							 | 
						
					
						
							
								
									
										
										
										
											2020-02-17 10:53:52 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								              llrz(75:77)=apmag*(-1)
							 | 
						
					
						
							
								
									
										
										
										
											2018-10-02 16:20:22 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								           else if(ncontest.eq.3) then
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								              apmask(1:28)=1  
							 | 
						
					
						
							
								
									
										
										
										
											2020-02-17 10:53:52 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								              llrz(1:28)=apmag*apsym(1:28)
							 | 
						
					
						
							
								
									
										
										
										
											2018-10-02 16:20:22 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								              apmask(75:77)=1 
							 | 
						
					
						
							
								
									
										
										
										
											2020-02-17 10:53:52 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								              llrz(75:77)=apmag*(-1)
							 | 
						
					
						
							
								
									
										
										
										
											2018-09-28 14:13:58 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								           else if(ncontest.eq.4) then
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								              apmask(2:29)=1  
							 | 
						
					
						
							
								
									
										
										
										
											2020-02-17 10:53:52 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								              llrz(2:29)=apmag*apsym(1:28)
							 | 
						
					
						
							
								
									
										
										
										
											2018-09-28 14:13:58 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								              apmask(75:77)=1 
							 | 
						
					
						
							
								
									
										
										
										
											2020-02-17 10:53:52 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								              llrz(75)=apmag*(-1)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								              llrz(76:77)=apmag*(+1)
							 | 
						
					
						
							
								
									
										
										
										
											2020-02-03 10:48:51 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								           else if(ncontest.eq.7) then ! ??? RR73; MyCall <Fox Call hash10> ???
							 | 
						
					
						
							
								
									
										
										
										
											2018-10-04 16:40:45 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								              apmask(29:56)=1  
							 | 
						
					
						
							
								
									
										
										
										
											2020-02-17 10:53:52 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								              llrz(29:56)=apmag*apsym(1:28)
							 | 
						
					
						
							
								
									
										
										
										
											2020-02-03 10:48:51 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								              apmask(57:66)=1
							 | 
						
					
						
							
								
									
										
										
										
											2020-02-17 10:53:52 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								              llrz(57:66)=apmag*aph10(1:10)
							 | 
						
					
						
							
								
									
										
										
										
											2018-10-04 16:40:45 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								              apmask(72:77)=1 
							 | 
						
					
						
							
								
									
										
										
										
											2020-02-17 10:53:52 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								              llrz(72:73)=apmag*(-1)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								              llrz(74)=apmag*(+1)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								              llrz(75:77)=apmag*(-1)
							 | 
						
					
						
							
								
									
										
										
										
											2018-09-28 14:13:58 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								           endif
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        endif
							 | 
						
					
						
							
								
									
										
										
										
											2018-09-29 09:16:56 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2018-09-28 14:13:58 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        if(iaptype.eq.3) then ! MyCall,DxCall,??? 
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								           apmask=0
							 | 
						
					
						
							
								
									
										
										
										
											2020-01-24 11:26:36 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								           if(ncontest.eq.0.or.ncontest.eq.1.or.ncontest.eq.2.or.ncontest.eq.5.or.ncontest.eq.7) then
							 | 
						
					
						
							
								
									
										
										
										
											2018-09-28 14:13:58 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								              apmask(1:58)=1  
							 | 
						
					
						
							
								
									
										
										
										
											2020-02-17 10:53:52 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								              llrz(1:58)=apmag*apsym
							 | 
						
					
						
							
								
									
										
										
										
											2018-09-28 14:13:58 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								              apmask(75:77)=1 
							 | 
						
					
						
							
								
									
										
										
										
											2020-02-17 10:53:52 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								              llrz(75:76)=apmag*(-1)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								              llrz(77)=apmag*(+1)
							 | 
						
					
						
							
								
									
										
										
										
											2018-10-02 16:20:22 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								           else if(ncontest.eq.3) then ! Field Day
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								              apmask(1:56)=1  
							 | 
						
					
						
							
								
									
										
										
										
											2020-02-17 10:53:52 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								              llrz(1:28)=apmag*apsym(1:28)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								              llrz(29:56)=apmag*apsym(30:57)
							 | 
						
					
						
							
								
									
										
										
										
											2018-10-04 16:40:45 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								              apmask(72:74)=1 
							 | 
						
					
						
							
								
									
										
										
										
											2018-10-02 16:20:22 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								              apmask(75:77)=1 
							 | 
						
					
						
							
								
									
										
										
										
											2020-02-17 10:53:52 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								              llrz(75:77)=apmag*(-1)
							 | 
						
					
						
							
								
									
										
										
										
											2020-01-24 11:26:36 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								           else if(ncontest.eq.4) then 
							 | 
						
					
						
							
								
									
										
										
										
											2018-09-28 14:13:58 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								              apmask(2:57)=1  
							 | 
						
					
						
							
								
									
										
										
										
											2020-02-17 10:53:52 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								              llrz(2:29)=apmag*apsym(1:28)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								              llrz(30:57)=apmag*apsym(30:57)
							 | 
						
					
						
							
								
									
										
										
										
											2018-09-28 14:13:58 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								              apmask(75:77)=1 
							 | 
						
					
						
							
								
									
										
										
										
											2020-02-17 10:53:52 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								              llrz(75)=apmag*(-1)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								              llrz(76:77)=apmag*(+1)
							 | 
						
					
						
							
								
									
										
										
										
											2018-09-28 14:13:58 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								           endif
							 | 
						
					
						
							
								
									
										
										
										
											2018-07-28 17:32:45 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        endif
							 | 
						
					
						
							
								
									
										
										
										
											2018-09-29 09:16:56 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2020-01-24 11:26:36 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        if(iaptype.eq.5.and.ncontest.eq.7) cycle !Hound
							 | 
						
					
						
							
								
									
										
										
										
											2018-07-28 17:32:45 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        if(iaptype.eq.4 .or. iaptype.eq.5 .or. iaptype.eq.6) then  
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								           apmask=0
							 | 
						
					
						
							
								
									
										
										
										
											2020-01-24 11:26:36 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								           if(ncontest.le.5 .or. (ncontest.eq.7.and.iaptype.eq.6)) then
							 | 
						
					
						
							
								
									
										
										
										
											2018-10-02 16:20:22 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								              apmask(1:77)=1   ! mycall, hiscall, RRR|73|RR73
							 | 
						
					
						
							
								
									
										
										
										
											2020-02-17 10:53:52 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								              llrz(1:58)=apmag*apsym
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								              if(iaptype.eq.4) llrz(59:77)=apmag*mrrr 
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								              if(iaptype.eq.5) llrz(59:77)=apmag*m73 
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								              if(iaptype.eq.6) llrz(59:77)=apmag*mrr73 
							 | 
						
					
						
							
								
									
										
										
										
											2020-01-24 11:26:36 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								           else if(ncontest.eq.7.and.iaptype.eq.4) then ! Hound listens for MyCall RR73;...
							 | 
						
					
						
							
								
									
										
										
										
											2018-10-02 16:20:22 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								              apmask(1:28)=1
							 | 
						
					
						
							
								
									
										
										
										
											2020-02-17 10:53:52 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								              llrz(1:28)=apmag*apsym(1:28)
							 | 
						
					
						
							
								
									
										
										
										
											2020-02-03 10:48:51 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								              apmask(57:66)=1
							 | 
						
					
						
							
								
									
										
										
										
											2020-02-17 10:53:52 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								              llrz(57:66)=apmag*aph10(1:10)
							 | 
						
					
						
							
								
									
										
										
										
											2018-10-02 16:20:22 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								              apmask(72:77)=1
							 | 
						
					
						
							
								
									
										
										
										
											2020-02-17 10:53:52 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								              llrz(72:73)=apmag*(-1)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								              llrz(74)=apmag*(1)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								              llrz(75:77)=apmag*(-1)
							 | 
						
					
						
							
								
									
										
										
										
											2018-10-02 16:20:22 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								           endif             
							 | 
						
					
						
							
								
									
										
										
										
											2018-07-28 17:32:45 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        endif
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     endif
							 | 
						
					
						
							
								
									
										
										
										
											2017-07-27 15:35:40 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     cw=0
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     dmin=0.0
							 | 
						
					
						
							
								
									
										
										
										
											2020-05-05 11:59:43 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     norder=2
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     maxosd=2
							 | 
						
					
						
							
								
									
										
										
										
											2020-06-16 10:54:36 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     if(ndepth.eq.1) maxosd=-1  ! BP only
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     if(ndepth.eq.2) maxosd=0   ! uncoupled BP+OSD
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     if(ndepth.eq.3 .and.         &
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        (abs(nfqso-f1).le.napwid .or. abs(nftx-f1).le.napwid .or. ncontest.eq.7)) then
							 | 
						
					
						
							
								
									
										
										
										
											2020-05-05 11:59:43 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        maxosd=2
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     endif
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     call timer('dec174_91 ',0)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     Keff=91
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     call decode174_91(llrz,Keff,maxosd,norder,apmask,message91,cw,  &
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								                       ntype,nharderrors,dmin)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     if(nharderrors.ge.0) message77=message91(1:77)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     call timer('dec174_91 ',1)
							 | 
						
					
						
							
								
									
										
										
										
											2018-07-04 16:20:12 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2018-07-03 15:59:24 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     msg37='                                     '
							 | 
						
					
						
							
								
									
										
										
										
											2020-06-16 11:09:46 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     nbadcrc=1
							 | 
						
					
						
							
								
									
										
										
										
											2018-07-08 13:29:12 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     if(nharderrors.lt.0 .or. nharderrors.gt.36) cycle
							 | 
						
					
						
							
								
									
										
										
										
											2017-07-27 15:35:40 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     if(count(cw.eq.0).eq.174) cycle           !Reject the all-zero codeword
							 | 
						
					
						
							
								
									
										
										
										
											2018-07-04 10:15:01 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     write(c77,'(77i1)') message77
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     read(c77(72:74),'(b3)') n3
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     read(c77(75:77),'(b3)') i3
							 | 
						
					
						
							
								
									
										
										
										
											2020-04-21 13:48:47 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     if(i3.gt.5 .or. (i3.eq.0.and.n3.gt.6)) cycle
							 | 
						
					
						
							
								
									
										
										
										
											2020-06-16 11:02:24 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     if(i3.eq.0 .and. n3.eq.2) cycle
							 | 
						
					
						
							
								
									
										
										
										
											2018-12-20 15:08:29 -06:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     call unpack77(c77,1,msg37,unpk77_success)
							 | 
						
					
						
							
								
									
										
										
										
											2020-06-16 11:02:24 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     if(.not.unpk77_success) cycle
							 | 
						
					
						
							
								
									
										
										
										
											2018-07-28 08:50:50 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     nbadcrc=0  ! If we get this far: valid codeword, valid (i3,n3), nonquirky message.
							 | 
						
					
						
							
								
									
										
										
										
											2019-04-18 14:16:39 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     call get_ft8_tones_from_77bits(message77,itone)
							 | 
						
					
						
							
								
									
										
										
										
											2020-02-28 11:25:32 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     if(lsubtract) then
							 | 
						
					
						
							
								
									
										
										
										
											2020-03-06 10:38:24 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        call timer('sub_ft8a',0)
							 | 
						
					
						
							
								
									
										
										
										
											2020-02-28 11:25:32 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        call subtractft8(dd0,itone,f1,xdt,.false.)
							 | 
						
					
						
							
								
									
										
										
										
											2020-03-06 10:38:24 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        call timer('sub_ft8a',1)
							 | 
						
					
						
							
								
									
										
										
										
											2020-02-28 11:25:32 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     endif
							 | 
						
					
						
							
								
									
										
										
										
											2018-06-17 12:11:32 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     xsig=0.0
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     xnoi=0.0
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     do i=1,79
							 | 
						
					
						
							
								
									
										
										
										
											2018-06-22 11:20:28 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        xsig=xsig+s8(itone(i),i)**2
							 | 
						
					
						
							
								
									
										
										
										
											2018-06-17 12:11:32 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        ios=mod(itone(i)+4,7)
							 | 
						
					
						
							
								
									
										
										
										
											2018-06-22 11:20:28 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        xnoi=xnoi+s8(ios,i)**2
							 | 
						
					
						
							
								
									
										
										
										
											2018-06-17 12:11:32 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     enddo
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     xsnr=0.001
							 | 
						
					
						
							
								
									
										
										
										
											2018-09-26 08:29:01 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     xsnr2=0.001
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     arg=xsig/xnoi-1.0 
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     if(arg.gt.0.1) xsnr=arg
							 | 
						
					
						
							
								
									
										
										
										
											2020-05-03 08:51:55 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     arg=xsig/xbase/3.0e6-1.0
							 | 
						
					
						
							
								
									
										
										
										
											2018-09-26 08:29:01 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     if(arg.gt.0.1) xsnr2=arg
							 | 
						
					
						
							
								
									
										
										
										
											2018-06-17 12:11:32 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     xsnr=10.0*log10(xsnr)-27.0
							 | 
						
					
						
							
								
									
										
										
										
											2018-09-26 08:29:01 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     xsnr2=10.0*log10(xsnr2)-27.0
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     if(.not.nagain) then
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								       xsnr=xsnr2
							 | 
						
					
						
							
								
									
										
										
										
											2020-05-04 10:55:53 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    endif
							 | 
						
					
						
							
								
									
										
										
										
											2020-06-16 10:54:36 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    if(nsync.le.10 .and. xsnr.lt.-24.0) then    !bail out, likely false decode
							 | 
						
					
						
							
								
									
										
										
										
											2020-05-04 10:55:53 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								       nbadcrc=1
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								       return
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    endif
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    if(xsnr .lt. -24.0) xsnr=-24.0
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    return
							 | 
						
					
						
							
								
									
										
										
										
											2017-07-08 14:06:48 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  enddo
							 | 
						
					
						
							
								
									
										
										
										
											2017-06-19 20:15:43 +00:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  return
							 | 
						
					
						
							
								
									
										
										
										
											2018-11-05 11:59:48 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								end subroutine ft8b
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								subroutine normalizebmet(bmet,n)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  real bmet(n)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  bmetav=sum(bmet)/real(n)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  bmet2av=sum(bmet*bmet)/real(n)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  var=bmet2av-bmetav*bmetav
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  if( var .gt. 0.0 ) then
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     bmetsig=sqrt(var)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  else
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     bmetsig=sqrt(bmet2av)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  endif
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  bmet=bmet/bmetsig
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  return
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								end subroutine normalizebmet
							 | 
						
					
						
							
								
									
										
										
										
											2018-06-05 16:37:29 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2017-08-22 00:14:51 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2018-11-05 11:59:48 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								function bessi0(x) 
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! From Numerical Recipes
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								   real bessi0,x
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								   double precision p1,p2,p3,p4,p5,p6,p7,q1,q2,q3,q4,q5,q6,q7,q8,q9,y
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								   save p1,p2,p3,p4,p5,p6,p7,q1,q2,q3,q4,q5,q6,q7,q8,q9
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								   data p1,p2,p3,p4,p5,p6,p7/1.0d0,3.5156229d0,3.0899424d0,1.2067492d0, &
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								      0.2659732d0,0.360768d-1,0.45813d-2/
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								   data q1,q2,q3,q4,q5,q6,q7,q8,q9/0.39894228d0,0.1328592d-1,           &
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								      0.225319d-2,-0.157565d-2,0.916281d-2,-0.2057706d-1,               &
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								      0.2635537d-1,-0.1647633d-1,0.392377d-2/
							 | 
						
					
						
							
								
									
										
										
										
											2017-09-17 15:34:32 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2018-11-05 11:59:48 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								   if (abs(x).lt.3.75) then 
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								      y=(x/3.75)**2
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								      bessi0=p1+y*(p2+y*(p3+y*(p4+y*(p5+y*(p6+y*p7))))) 
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								   else
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								      ax=abs(x)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								      y=3.75/ax 
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								      bessi0=(exp(ax)/sqrt(ax))*(q1+y*(q2+y*(q3+y*(q4         &
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								           +y*(q5+y*(q6+y*(q7+y*(q8+y*q9))))))))
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								   endif
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								   return
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								end function bessi0
							 |