Документ взят из кэша поисковой машины. Адрес оригинального документа : http://www.mrao.cam.ac.uk/~rachael/compphys/examples/exercise2.f90 Дата изменения: Tue Oct 11 19:42:52 2005 Дата индексирования: Tue Oct 2 11:40:23 2012 Кодировка: Поисковые слова: m 13

! Example solution to suggested exercise 2
! from self-study guide 2

program exercise2

use nag_f77_c_chapter
implicit none

integer, parameter :: dp = selected_real_kind(12)
integer, parameter :: length = 128
real(dp) :: a, ainv
real(dp) :: x(length), y(length)

! Read parameter a from terminal
write(*,*) 'Enter parameter a:'
read(*,*) a
if (a == 0.0_dp) stop 'a must be non-zero!'
ainv = 1.0_dp / a

! Initialise x and y
call init_arrays(ainv, x, y)

! Fourier transform x and y
call fourier(x, y)

! Output result to file
call output_arrays('exercise2.dat', x, y)

contains

! This subroutine initialises the arrays such that:
! x(i) = sin(b*i)
! y(i) = 0

subroutine init_arrays(b, x, y)

! Arguments
real(dp), intent(in) :: b
real(dp), intent(out), dimension(:) :: x, y

! Local variables
integer :: n, i

! Get size of arrays
n = size(x)

! Set array y to zero
y = 0.0_dp

! Set array x
do i = 1, n
x(i) = sin(b*i)
end do

end subroutine init_arrays


! This subroutine Fourier transforms the arrays

subroutine fourier(x, y)

! Arguments
real(dp), intent(inout), dimension(:) :: x, y

! Local variables
integer :: n, ifail

! Get size of arrays
n = size(x)

! Call NAG FFT routine
ifail = 0
call C06ECF(x, y, n, ifail)
if (ifail /= 0) then
write(*,*) 'Error in C06ECF: ifail = ',ifail
stop
end if

end subroutine fourier


! This subroutine outputs two arrays to a file

subroutine output_arrays(filename, x, y)

! Arguments
character(len=*), intent(in) :: filename
real(dp), intent(in), dimension(:) :: x, y

! Local variables
integer :: i, ierr

! Open file for output
open(9,file=filename,iostat=ierr,status='replace',action='write')
if (ierr /= 0) then
write(*,*) 'Error opening file "',filename,'"; iostat = ',ierr
stop
end if

! Write data to file
do i = 1, size(x)
write(9,*) i-1, x(i), y(i)
end do

! Close file
close(9)

end subroutine output_arrays

end program exercise2