From 9123fb4979cfd03ec518bba1d17ed5fa90d92920 Mon Sep 17 00:00:00 2001 From: Steven Franke Date: Thu, 9 Jun 2016 10:30:52 +0000 Subject: [PATCH] Add msk144dt.f90 git-svn-id: svn+ssh://svn.code.sf.net/p/wsjt/wsjt/branches/wsjtx@6746 ab8295b8-cf94-4d9e-aec4-7959e3be5d79 --- lib/msk144dt.f90 | 78 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 78 insertions(+) create mode 100644 lib/msk144dt.f90 diff --git a/lib/msk144dt.f90 b/lib/msk144dt.f90 new file mode 100644 index 000000000..1d331ac66 --- /dev/null +++ b/lib/msk144dt.f90 @@ -0,0 +1,78 @@ +subroutine msk144dt(d,npts,ty,yellow,nyel) + + parameter (NFFT=1024,NH=NFFT/2) + real d(npts) + real x(0:NFFT-1) + real green(703) + real yellow(703) !703 = 30*12000/512 + real ty(703) + real y2(175) + real ty2(175) + integer indx(703) + logical ok + complex c(0:NH) + equivalence (x,c) + + df=12000.0/NFFT + i1=nint(300.0/df) + i2=nint(800.0/df) + i3=nint(2200.0/df) + i4=nint(2700.0/df) + nblks=npts/NH - 1 + + do j=1,nblks + ib=(j+1)*NH + ia=ib-NFFT+1 + x=d(ia:ib) + call four2a(x,NFFT,1,-1,0) !r2c FFT + sqlow=0. + do i=i1,i2 + sqlow=sqlow + real(c(i))**2 + aimag(c(i))**2 + enddo + sqmid=0. + do i=i2,i3 + sqmid=sqmid + real(c(i))**2 + aimag(c(i))**2 + enddo + sqhigh=0. + do i=i3,i4 + sqhigh=sqhigh + real(c(i))**2 + aimag(c(i))**2 + enddo + green(j)=db(sqlow+sqmid+sqhigh) + yellow(j)=db(sqmid/(sqlow+sqhigh)) + ty(j)=j*512.0/12000.0 + enddo + + npct=20 + call pctile(green,nblks,npct,base) + green(1:nblks)=green(1:nblks) - base - 0.3 + call pctile(yellow,nblks,npct,base) + yellow(1:nblks)=yellow(1:nblks) - base - 0.6 + call indexx(yellow,nblks,indx) + + do j=1,nblks/4 + k=indx(nblks+1-j) + ty(j)=ty(k) + yellow(j)=yellow(k) + if(yellow(j).lt.1.4) exit + enddo + nyel=j-1 + k=1 + y2(1)=yellow(1) + ty2(1)=ty(1) + do j=2,nyel + ok=.true. + do i=1,j-1 + if(abs(ty(i)-ty(j)).lt.0.05) ok=.false. + enddo + if(ok) then + k=k+1 + y2(k)=yellow(j) + ty2(k)=ty(j) + endif + enddo + nyel=k + yellow(1:nyel)=y2(1:nyel) + ty(1:nyel)=ty2(1:nyel) + + return +end subroutine msk144dt