PROGRAM c06frfe ! C06FRF Example Program Text ! Mark 23 Release. NAG Copyright 2011. ! .. Use Statements .. USE nag_library, ONLY : c06frf, c06gcf, nag_wp ! .. Implicit None Statement .. IMPLICIT NONE ! .. Parameters .. INTEGER, PARAMETER :: nin = 5, nout = 6 CHARACTER (7), PARAMETER :: init_first = 'Initial' CHARACTER (10), PARAMETER :: init_repeat = 'Subsequent' ! .. Local Scalars .. INTEGER :: i, ieof, ifail, lwork, m, mn, n, n2 ! .. Local Arrays .. REAL (KIND=nag_wp), ALLOCATABLE :: trig(:), work(:), x(:,:), y(:,:) ! .. Executable Statements .. WRITE (nout,*) 'C06FRF Example Program Results' ! Skip heading in data file READ (nin,*) LOOP: DO READ (nin,*,IOSTAT=ieof) m, n mn = m*n n2 = 2*n lwork = 2*mn IF (ieof<0) EXIT LOOP ALLOCATE (trig(n2),x(m,n),y(m,n),work(lwork)) DO i = 1, m READ (nin,*) x(i,1:n) READ (nin,*) y(i,1:n) END DO WRITE (nout,*) WRITE (nout,*) 'Original data values' DO i = 1, m WRITE (nout,*) WRITE (nout,99999) 'Real ', x(i,1:n) WRITE (nout,99999) 'Imag ', y(i,1:n) END DO ! ifail: behaviour on error exit ! =0 for hard exit, =1 for quiet-soft, =-1 for noisy-soft ifail = 0 CALL c06frf(m,n,x,y,init_first,trig,work,ifail) WRITE (nout,*) WRITE (nout,*) 'Discrete Fourier transforms' DO i = 1, m WRITE (nout,*) WRITE (nout,99999) 'Real ', x(i,1:n) WRITE (nout,99999) 'Imag ', y(i,1:n) END DO CALL c06gcf(y,mn,ifail) ifail = 0 CALL c06frf(m,n,x,y,init_repeat,trig,work,ifail) CALL c06gcf(y,mn,ifail) WRITE (nout,*) WRITE (nout,*) 'Original data as restored by inverse transform' DO i = 1, m WRITE (nout,*) WRITE (nout,99999) 'Real ', x(i,1:n) WRITE (nout,99999) 'Imag ', y(i,1:n) END DO DEALLOCATE (trig,x,y,work) END DO LOOP 99999 FORMAT (1X,A,6F10.4) END PROGRAM c06frfe