PROGRAM nag_fft_ex02 ! Example Program Text for nag_fft ! NAG fl90, Release 4. NAG Copyright 2000. ! .. Use Statements .. USE nag_examples_io, ONLY : nag_std_in, nag_std_out USE nag_fft, ONLY : nag_fft_1d_basic, nag_key_cmplx, nag_fft_trig USE nag_write_mat, ONLY : nag_write_gen_mat ! .. Implicit None Statement .. IMPLICIT NONE ! .. Intrinsic Functions .. INTRINSIC CONJG, KIND ! .. Parameters .. INTEGER, PARAMETER :: wp = KIND(1.0D0) ! .. Local Scalars .. INTEGER :: i, m, n ! .. Local Arrays .. REAL (wp), ALLOCATABLE :: trig(:) COMPLEX (wp), ALLOCATABLE :: z(:,:) ! .. Executable Statements .. WRITE (nag_std_out,*) 'Example Program Results for nag_fft_ex02' WRITE (nag_std_out,*) READ (nag_std_in,*) ! Skip heading in data file READ (nag_std_in,*) m, n ALLOCATE (z(m,n),trig(2*n)) ! Allocate storage DO i = 1, m READ (nag_std_in,*) z(i,:) END DO CALL nag_write_gen_mat(z,format='f7.4',int_row_labels=.TRUE., & title='Original data values') WRITE (nag_std_out,*) CALL nag_fft_trig(trig) CALL nag_fft_1d_basic(nag_key_cmplx,z,trig=trig) CALL nag_write_gen_mat(z,format='f7.4',int_row_labels=.TRUE., & title='Discrete Fourier transforms') WRITE (nag_std_out,*) z = CONJG(z) CALL nag_fft_1d_basic(nag_key_cmplx,z,trig=trig) z = CONJG(z) CALL nag_write_gen_mat(z,format='f7.4',int_row_labels=.TRUE., & title='Original data restored by inverse transform') DEALLOCATE (z,trig) ! Deallocate storage END PROGRAM nag_fft_ex02