Документ взят из кэша поисковой машины. Адрес оригинального документа : http://www.mrao.cam.ac.uk/~rachael/compphys/examples/shm.f90 Дата изменения: Fri Sep 30 14:30:32 2005 Дата индексирования: Tue Oct 2 10:28:32 2012 Кодировка: Поисковые слова: orion

! Simple harmonic motion

module constants

implicit none
integer, parameter :: dp = kind(1.0d0)
integer, parameter :: num_eqn = 2
integer, parameter :: num_steps = 100
real(dp), parameter :: pi = 3.141592653589793d0
real(dp), parameter :: xstart = 0.0d0
real(dp), parameter :: xend = 10.0d0
real(dp), parameter :: spacing = (xend - xstart) / num_steps
real(dp), parameter :: mass = 1.0d0 / pi
real(dp), parameter :: spring = pi

end module constants


module routines

use constants

contains

subroutine derivative(x, y, f)

implicit none
real(dp), intent(in) :: x
real(dp), intent(in) :: y(num_eqn)
real(dp), intent(out) :: f(num_eqn)

f(1) = y(2) / mass
f(2) = -spring * y(1)

end subroutine derivative

subroutine output(x, y)

implicit none
real(dp), intent(inout) :: x
real(dp), intent(in) :: y(num_eqn)
real(dp) :: energy

energy = 0.5d0 * spring * y(1)*y(1) + 0.5d0 * y(2)*y(2) / mass

write(*,1) x, y(1), y(2), energy - 0.5d0 / mass
1 format(4f14.8)

x = x + spacing

end subroutine output

end module routines


program shm

use constants
use routines
use nag_f77_d_chapter
implicit none
integer :: ifail
real(dp) :: x, &
ystart(num_eqn), &
tol, &
work(20 * num_eqn)

x = xstart
ystart(1) = 0.0d0 ! initial position
ystart(2) = 1.0d0 ! initial momentum
tol = 1.0d-6 ! indicates required accuracy
ifail = 0
call D02BJF(x, xend, num_eqn, ystart, &
derivative, tol, 'D', output, D02BJW, work, ifail)

end program shm