Updated to r8541

2018-03-05 14:49:51 -05:00
parent a4fa5b9988
commit a32fe6a4dc
200 changed files with 20394 additions and 4957 deletions
@@ -0,0 +1,48 @@
+subroutine baseline(s,nfa,nfb,sbase)
+
+! Fit baseline to spectrum (for FT8)
+! Input:  s(npts)         Linear scale in power
+! Output: sbase(npts)    Baseline
+
+  implicit real*8 (a-h,o-z)
+  real*4 s(1920)
+  real*4 sbase(1920)
+  real*4 base
+  real*8 x(1000),y(1000),a(5)
+  data nseg/10/,npct/10/
+
+  df=12000.0/3840.0                    !3.125 Hz
+  ia=max(1,nint(nfa/df))
+  ib=nint(nfb/df)
+  do i=ia,ib
+     s(i)=10.0*log10(s(i))            !Convert to dB scale
+  enddo
+
+  nterms=5
+  nlen=(ib-ia+1)/nseg                 !Length of test segment
+  i0=(ib-ia+1)/2                      !Midpoint
+  k=0
+  do n=1,nseg                         !Loop over all segments
+     ja=ia + (n-1)*nlen
+     jb=ja+nlen-1
+     call pctile(s(ja),nlen,npct,base) !Find lowest npct of points
+     do i=ja,jb
+        if(s(i).le.base) then
+           if (k.lt.1000) k=k+1       !Save all "lower envelope" points
+           x(k)=i-i0
+           y(k)=s(i)
+        endif
+     enddo
+  enddo
+  kz=k
+  a=0.
+  call polyfit(x,y,y,kz,nterms,0,a,chisqr)  !Fit a low-order polynomial
+  do i=ia,ib
+     t=i-i0
+     sbase(i)=a(1)+t*(a(2)+t*(a(3)+t*(a(4)+t*(a(5))))) + 0.65
+!     write(51,3051) i*df,s(i),sbase(i)
+!3051 format(3f12.3)
+  enddo
+
+  return
+end subroutine baseline