dfft2b


NAME

dfft2b - compute a periodic sequence from its Fourier coefficients. The DFFT operations are unnormalized, so a call of DFFT2F followed by a call of DFFT2B will multiply the input sequence by M*N.


SYNOPSIS

  SUBROUTINE DFFT2B( PLACE, M, N, A, LDA, B, LDB, WORK, LWORK)
  CHARACTER * 1 PLACE
  INTEGER M, N, LDA, LDB, LWORK
  DOUBLE PRECISION A(LDA,*), B(LDB,*), WORK(*)
 
  SUBROUTINE DFFT2B_64( PLACE, M, N, A, LDA, B, LDB, WORK, LWORK)
  CHARACTER * 1 PLACE
  INTEGER*8 M, N, LDA, LDB, LWORK
  DOUBLE PRECISION A(LDA,*), B(LDB,*), WORK(*)
 

F95 INTERFACE

  SUBROUTINE FFT2B( PLACE, [M], [N], A, [LDA], B, [LDB], WORK, LWORK)
  CHARACTER(LEN=1) :: PLACE
  INTEGER :: M, N, LDA, LDB, LWORK
  REAL(8), DIMENSION(:) :: WORK
  REAL(8), DIMENSION(:,:) :: A, B
 
  SUBROUTINE FFT2B_64( PLACE, [M], [N], A, [LDA], B, [LDB], WORK, 
 *       LWORK)
  CHARACTER(LEN=1) :: PLACE
  INTEGER(8) :: M, N, LDA, LDB, LWORK
  REAL(8), DIMENSION(:) :: WORK
  REAL(8), DIMENSION(:,:) :: A, B
 

C INTERFACE

#include <sunperf.h>

void dfft2b(char place, int m, int n, double *a, int lda, double *b, int ldb, double *work, int lwork);

void dfft2b_64(char place, long m, long n, double *a, long lda, double *b, long ldb, double *work, long lwork);


ARGUMENTS

* PLACE (input)
Character. If PLACE = 'I' or 'i' (for in-place) , the input and output data are stored in array A. If PLACE = 'O' or 'o' (for out-of-place), the input data is stored in array B while the output is stored in A.

* M (input)
Integer specifying the number of rows to be transformed. It is most efficient when M is a product of small primes. M >= 0; when M = 0, the subroutine returns immediately without changing any data.

* N (input)
Integer specifying the number of columns to be transformed. It is most most efficient when N is a product of small primes. N >= 0; when N = 0, the subroutine returns immediately without changing any data.

* A (input/output)
Real array of dimension (LDA,N). On entry, the two-dimensional array A(LDA,N) contains the input data to be transformed if an in-place transform is requested. Otherwise, it is not referenced. Upon exit, results are stored in A(1:M,1:N).

* LDA (input)
Integer specifying the leading dimension of A. If an out-of-place transform is desired LDA >= M. Else if an in-place transform is desired LDA >= 2*(M/2+1).

* B (input/output)
Real array of dimension (2*LDB, N). On entry, if an out-of-place transform is requested B contains the input data. Otherwise, B is not referenced. B is unchanged upon exit.

* LDB (input)
Integer. If an out-of-place transform is desired, 2*LDB is the leading dimension of the array B which contains the data to be transformed and 2*LDB >= 2*(M/2+1). Otherwise it is not referenced.

* WORK (input/output)
One-dimensional real array of length at least LWORK. On input, WORK must have been initialized by DFFT2I.

* LWORK (input)
Integer. LWORK >= (M + 2*N + MAX(M, 2*N) + 30)