1!-------------------------------------------------------------------------------
2!
3! This file is part of the WSPR application, Weak Signal Propogation Reporter
4!
5! File Name:    twkfreq.f90
6! Description:  Apply AFC corrections to ca, returning corrected data in cb
7!
8! Copyright (C) 2001-2014 Joseph Taylor, K1JT
9! License: GPL-3+
10!
11! This program is free software; you can redistribute it and/or modify it under
12! the terms of the GNU General Public License as published by the Free Software
13! Foundation; either version 3 of the License, or (at your option) any later
14! version.
15!
16! This program is distributed in the hope that it will be useful, but WITHOUT
17! ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
18! FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
19! details.
20!
21! You should have received a copy of the GNU General Public License along with
22! this program; if not, write to the Free Software Foundation, Inc., 51 Franklin
23! Street, Fifth Floor, Boston, MA 02110-1301, USA.
24!
25!-------------------------------------------------------------------------------
26subroutine twkfreq(ca,cb,jz,a)
27
28! Apply AFC corrections to ca, returning corrected data in cb
29
30  complex ca(jz),cb(jz)
31  real a(5)
32  real*8 twopi
33  complex*16 w,wstep
34  data twopi/0.d0/
35  save twopi
36
37  if(twopi.eq.0.d0) twopi=8.d0*atan(1.d0)
38  w=1.d0
39  wstep=1.d0
40  x0=0.5*(jz+1)
41  s=2.0/jz
42  do i=1,jz
43     x=s*(i-x0)
44     if(mod(i,100).eq.1) then
45        p2=1.5*x*x - 0.5
46!            p3=2.5*(x**3) - 1.5*x
47!            p4=4.375*(x**4) - 3.75*(x**2) + 0.375
48        dphi=(a(1) + x*a(2) + p2*a(3)) * (twopi/375.0)
49        wstep=cmplx(cos(dphi),sin(dphi))
50     endif
51     w=w*wstep
52     cb(i)=w*ca(i)
53  enddo
54
55  return
56end subroutine twkfreq
57