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

program quantum

use nag_f77_f_chapter
implicit none

integer, parameter :: dp = kind(1.0d0)
integer :: nbasis
integer :: n, m, lwk,ifail
real(dp), parameter :: pisqon4 = 2.4674011002723397d0
real(dp), allocatable :: h(:,:),s(:,:),e(:),wrk(:)

write(*,*) 'Enter number of basis functions: '
read(*,*) nbasis

! allocate arrays
lwk = 3*nbasis
allocate(h(nbasis,nbasis), s(nbasis,nbasis), e(nbasis), wrk(lwk))

! set up matrices: basis functions are labelled from zero whereas
! array indices start at one
h = 0.0d0 ; s = 0.0d0
do m=0,nbasis-1
do n=m,nbasis-1 ! fill upper triangle only
if (mod(m+n,2) == 0) then
h(m+1,n+1) = (8.0d0*(2*m*n+m+n-1))/((m+n+3)*(m+n+1)*(m+n-1))
s(m+1,n+1) = 16.0d0/((m+n+5)*(m+n+3)*(m+n+1))
end if
end do
end do

! call NAG routine to solve generalised eigenvalue problem
ifail = 0
call f02fdf(1,'N','U',nbasis,h,nbasis,s,nbasis,e,wrk,lwk,ifail)

! report results and compare against known exact solution
if (ifail == 0) then
write(*,'(11x,a,11x,a)') 'Computed','% error'
do n=1,nbasis
write(*,'(i6,f18.12,f18.12)') n,e(n),(e(n)/(n*n*pisqon4)-1)*1.0d2
end do
else
write(*,*) 'NAG routine F02FDF failed with ifail = ',ifail
end if

end program