1      SUBROUTINE EZFFTF(N,R,AZERO,A,B,WSAVE)
2C***BEGIN PROLOGUE  EZFFTF
3C***DATE WRITTEN   790601   (YYMMDD)
4C***REVISION DATE  830401   (YYMMDD)
5C***REVISION HISTORY  (YYMMDD)
6C   000330  Modified array declarations.  (JEC)
7C
8C***CATEGORY NO.  J1A1
9C***KEYWORDS  FOURIER TRANSFORM
10C***AUTHOR  SWARZTRAUBER, P. N., (NCAR)
11C***PURPOSE  A simplified real, periodic, forward transform
12C***DESCRIPTION
13C
14C  Subroutine EZFFTF computes the Fourier coefficients of a real
15C  perodic sequence (Fourier analysis).  The transform is defined
16C  below at Output Parameters AZERO, A and B.  EZFFTF is a simplified
17C  but slower version of RFFTF.
18C
19C  Input Parameters
20C
21C  N       the length of the array R to be transformed.  The method
22C          is must efficient when N is the product of small primes.
23C
24C  R       a real array of length N which contains the sequence
25C          to be transformed.  R is not destroyed.
26C
27C
28C  WSAVE   a work array which must be dimensioned at least 3*N+15
29C          in the program that calls EZFFTF.  The WSAVE array must be
30C          initialized by calling subroutine EZFFTI(N,WSAVE), and a
31C          different WSAVE array must be used for each different
32C          value of N.  This initialization does not have to be
33C          repeated so long as N remains unchanged.  Thus subsequent
34C          transforms can be obtained faster than the first.
35C          The same WSAVE array can be used by EZFFTF and EZFFTB.
36C
37C  Output Parameters
38C
39C  AZERO   the sum from I=1 to I=N of R(I)/N
40C
41C  A,B     for N even B(N/2)=0. and A(N/2) is the sum from I=1 to
42C          I=N of (-1)**(I-1)*R(I)/N
43C
44C          for N even define KMAX=N/2-1
45C          for N odd  define KMAX=(N-1)/2
46C
47C          then for  k=1,...,KMAX
48C
49C               A(K) equals the sum from I=1 to I=N of
50C
51C                    2./N*R(I)*COS(K*(I-1)*2*PI/N)
52C
53C               B(K) equals the sum from I=1 to I=N of
54C
55C                    2./N*R(I)*SIN(K*(I-1)*2*PI/N)
56C***REFERENCES  (NONE)
57C***ROUTINES CALLED  RFFTF
58C***END PROLOGUE  EZFFTF
59      DIMENSION       R(*)       ,A(*)       ,B(*)       ,WSAVE(*)
60C***FIRST EXECUTABLE STATEMENT  EZFFTF
61      IF (N-2) 101,102,103
62  101 AZERO = R(1)
63      RETURN
64  102 AZERO = .5*(R(1)+R(2))
65      A(1) = .5*(R(1)-R(2))
66      RETURN
67  103 DO 104 I=1,N
68         WSAVE(I) = R(I)
69  104 CONTINUE
70      CALL RFFTF (N,WSAVE,WSAVE(N+1))
71      CF = 2./FLOAT(N)
72      CFM = -CF
73      AZERO = .5*CF*WSAVE(1)
74      NS2 = (N+1)/2
75      NS2M = NS2-1
76      DO 105 I=1,NS2M
77         A(I) = CF*WSAVE(2*I)
78         B(I) = CFM*WSAVE(2*I+1)
79  105 CONTINUE
80      IF (MOD(N,2) .EQ. 0) A(NS2) = .5*CF*WSAVE(N)
81      RETURN
82      END
83