PROGRAM nag_conv_ex01 ! Example Program Text for nag_conv ! NAG fl90, Release 4. NAG Copyright 2000. ! .. Use Statements .. USE nag_examples_io, ONLY : nag_std_in, nag_std_out USE nag_conv, ONLY : nag_fft_conv ! .. Implicit None Statement .. IMPLICIT NONE ! .. Intrinsic Functions .. INTRINSIC KIND ! .. Parameters .. INTEGER, PARAMETER :: wp = KIND(1.0D0) ! .. Local Scalars .. INTEGER :: i, n ! .. Local Arrays .. REAL (wp), ALLOCATABLE :: result(:), x(:), y(:) ! .. Executable Statements .. WRITE (nag_std_out,*) 'Example Program Results for nag_conv_ex01' READ (nag_std_in,*) ! Skip heading in data file READ (nag_std_in,*) n ALLOCATE (x(n),y(n),result(n)) ! Allocate storage READ (nag_std_in,*) (x(i),y(i),i=1,n) result = nag_fft_conv(x,y) WRITE (nag_std_out,*) WRITE (nag_std_out,*) 'Convolution' WRITE (nag_std_out,'(5f10.4)') result result = nag_fft_conv(x,y,correl=.TRUE.) WRITE (nag_std_out,*) WRITE (nag_std_out,*) 'Correlation' WRITE (nag_std_out,'(5f10.4)') result DEALLOCATE (x,y,result) ! Deallocate storage END PROGRAM nag_conv_ex01