Go to main content
Oracle Developer Studio 12.5 Man Pages

Exit Print View

Updated: June 2017
 
 

zfftz (3p)

Name

zfftz - pute the Fast Fourier transform (forward or inverse) of a double com- plex sequence.

Synopsis

SUBROUTINE ZFFTZ(IOPT, N, SCALE, X, Y, TRIGS, IFAC, WORK, LWORK, IERR)

INTEGER IOPT, N, IFAC(*), LWORK, IERR
DOUBLE COMPLEX X(*), Y(*)
DOUBLE PRECISION SCALE, TRIGS(*), WORK(*)

SUBROUTINE ZFFTZ_64(IOPT, N, SCALE, X, Y, TRIGS, IFAC, WORK, LWORK, IERR)

INTEGER*8 IOPT, N, IFAC(*), LWORK, IERR
DOUBLE PRECISION SCALE, TRIGS(*), WORK(*)
DOUBLE COMPLEX X(*), Y(*)




F95 INTERFACE
SUBROUTINE FFT(IOPT, N, SCALE, X, Y, TRIGS, IFAC, WORK, LWORK, IERR)

INTEGER, INTENT(IN) :: IOPT
INTEGER, INTENT(IN), OPTIONAL :: N, LWORK
REAL(8), INTENT(IN), OPTIONAL :: SCALE
COMPLEX(8), INTENT(IN), DIMENSION(:) :: X
COMPLEX(8), INTENT(OUT), DIMENSION(:) :: Y
REAL(8), INTENT(INOUT), DIMENSION(:) :: TRIGS
INTEGER, INTENT(INOUT), DIMENSION(:) :: IFAC
REAL(8), INTENT(OUT), DIMENSION(:) :: WORK
INTEGER, INTENT(OUT) :: IERR

SUBROUTINE FFT_64(IOPT, N, SCALE, X, Y, TRIGS, IFAC, WORK, LWORK, IERR)

INTEGER(8), INTENT(IN) :: IOPT
INTEGER(8), INTENT(IN), OPTIONAL :: N, LWORK
REAL(8), INTENT(IN), OPTIONAL :: SCALE
COMPLEX(8), INTENT(IN), DIMENSION(:) :: X
COMPLEX(8), INTENT(OUT), DIMENSION(:) :: Y
REAL(8), INTENT(INOUT), DIMENSION(:) :: TRIGS
INTEGER(8), INTENT(INOUT), DIMENSION(:) :: IFAC
REAL(8), INTENT(OUT), DIMENSION(:) :: WORK
INTEGER(8), INTENT(OUT) :: IERR




C INTERFACE
#include <sunperf.h>

void  zfftz_  (int *iopt, int *n, double *scale, doublecomplex *x, dou-
blecomplex *y, double *trigs, int *ifac,  double  *work,  int
*lwork, int *ierr);

void  zfftz_64_  (long *iopt, long *n, double *scale, doublecomplex *x,
doublecomplex *y, double *trigs, long  *ifac,  double  *work,
long *lwork, long *ierr);

Description

Oracle Solaris Studio Performance Library                            zfftz(3P)



NAME
       zfftz  -  initialize the trigonometric weight and factor tables or com-
       pute the Fast Fourier transform (forward or inverse) of a  double  com-
       plex sequence.

SYNOPSIS
       SUBROUTINE ZFFTZ(IOPT, N, SCALE, X, Y, TRIGS, IFAC, WORK, LWORK, IERR)

       INTEGER IOPT, N, IFAC(*), LWORK, IERR
       DOUBLE COMPLEX X(*), Y(*)
       DOUBLE PRECISION SCALE, TRIGS(*), WORK(*)

       SUBROUTINE ZFFTZ_64(IOPT, N, SCALE, X, Y, TRIGS, IFAC, WORK, LWORK, IERR)

       INTEGER*8 IOPT, N, IFAC(*), LWORK, IERR
       DOUBLE PRECISION SCALE, TRIGS(*), WORK(*)
       DOUBLE COMPLEX X(*), Y(*)




   F95 INTERFACE
       SUBROUTINE FFT(IOPT, N, SCALE, X, Y, TRIGS, IFAC, WORK, LWORK, IERR)

       INTEGER, INTENT(IN) :: IOPT
       INTEGER, INTENT(IN), OPTIONAL :: N, LWORK
       REAL(8), INTENT(IN), OPTIONAL :: SCALE
       COMPLEX(8), INTENT(IN), DIMENSION(:) :: X
       COMPLEX(8), INTENT(OUT), DIMENSION(:) :: Y
       REAL(8), INTENT(INOUT), DIMENSION(:) :: TRIGS
       INTEGER, INTENT(INOUT), DIMENSION(:) :: IFAC
       REAL(8), INTENT(OUT), DIMENSION(:) :: WORK
       INTEGER, INTENT(OUT) :: IERR

       SUBROUTINE FFT_64(IOPT, N, SCALE, X, Y, TRIGS, IFAC, WORK, LWORK, IERR)

       INTEGER(8), INTENT(IN) :: IOPT
       INTEGER(8), INTENT(IN), OPTIONAL :: N, LWORK
       REAL(8), INTENT(IN), OPTIONAL :: SCALE
       COMPLEX(8), INTENT(IN), DIMENSION(:) :: X
       COMPLEX(8), INTENT(OUT), DIMENSION(:) :: Y
       REAL(8), INTENT(INOUT), DIMENSION(:) :: TRIGS
       INTEGER(8), INTENT(INOUT), DIMENSION(:) :: IFAC
       REAL(8), INTENT(OUT), DIMENSION(:) :: WORK
       INTEGER(8), INTENT(OUT) :: IERR




   C INTERFACE
       #include <sunperf.h>

       void  zfftz_  (int *iopt, int *n, double *scale, doublecomplex *x, dou-
                 blecomplex *y, double *trigs, int *ifac,  double  *work,  int
                 *lwork, int *ierr);

       void  zfftz_64_  (long *iopt, long *n, double *scale, doublecomplex *x,
                 doublecomplex *y, double *trigs, long  *ifac,  double  *work,
                 long *lwork, long *ierr);



PURPOSE
       zfftz  initializes  the  trigonometric weight and factor tables or com-
       putes the Fast Fourier transform (forward or inverse) of a double  com-
       plex sequence as follows:

                      N-1
       Y(k) = scale * SUM  W*X(j)
                      j=0

       where
       k ranges from 0 to N-1
       i = sqrt(-1)
       isign = 1 for inverse transform or -1 for forward transform
       W = exp(isign*i*j*k*2*pi/N)


ARGUMENTS
       IOPT (input)
                 Integer specifying the operation to be performed:
                 IOPT  =  0 computes the trigonometric weight table and factor
                 table
                 IOPT = -1 computes forward FFT
                 IOPT = +1 computes inverse FFT

       N (input)
                 Integer specifying length of the input sequence X.  N is most
                 efficient  when  it  is  a  product of small primes.  N >= 0.
                 Unchanged on exit.


       SCALE (input)
                 Double  precision  scalar  by  which  transform  results  are
                 scaled.  Unchanged on exit.


       X (input) On entry, X is a double complex array of dimension at least N
                 that contains the sequence to be transformed.


       Y (output)
                 Double complex array of dimension at least  N  that  contains
                 the  transform results.  X and Y may be the same array start-
                 ing at the same memory location.  Otherwise,  it  is  assumed
                 that there is no overlap between X and Y in memory.


       TRIGS (input/output)
                 Double  precision  array  of  length  2*N  that  contains the
                 trigonometric weights.  The weights  are  computed  when  the
                 routine  is  called with IOPT = 0 and they are used in subse-
                 quent calls when IOPT = 1 or IOPT = -1.  Unchanged on exit.


       IFAC (input/output)
                 Integer array of dimension at least  128  that  contains  the
                 factors  of  N.  The factors are computed when the routine is
                 called with IOPT = 0 and they are used  in  subsequent  calls
                 where IOPT = 1 or IOPT = -1.  Unchanged on exit.


       WORK (workspace)
                 Double  precision  array of dimension at least 2*N.  The user
                 can  also  choose  to  have  the  routine  allocate  its  own
                 workspace (see LWORK).


       LWORK (input)
                 Integer specifying workspace size.  If LWORK = 0, the routine
                 will allocate its own workspace.


       IERR (output)
                 On exit, integer IERR has one of the following values:
                 0 = normal return
                 -1 = IOPT is not 0, 1 or -1
                 -2 = N < 0
                 -3 = (LWORK is not 0) and (LWORK is less than 2*N)
                 -4 = memory allocation for workspace failed

SEE ALSO
       fft



                                  7 Nov 2015                         zfftz(3P)