Документ взят из кэша поисковой машины. Адрес оригинального документа : http://num-anal.srcc.msu.ru/meth_mat/prac_alg/arfil/symfor1.txt Дата изменения: Tue Dec 17 12:59:02 2002 Дата индексирования: Mon Oct 1 23:20:09 2012 Кодировка: Windows-1251

ТЕКСТЫ ТЕСТОВЫХ ПРОГРАММ

1. Программа вычисления определителей на Фортране

program sdet
double precision det
d = 4.
c = 1.
n = 2
call ads4d ( d, c, n, det )
write(*,33) d, c, n, det
33 FORMAT(2x,'d, c, n, det', 2X, 2E12.4, I4, E12.4)
stop
END
subroutine ads4d( d, c, n, det )
c Вычисление определителя
c симметричной якобиевой матрицы
c с одинаковыми диагональными элементами.
c
c Параметры программы:
c d - диагональный элемент
c c - внедиагональный элемент
c n - порядок матрицы
c det - значение определителя
c
integer n
double precision det, fi, p, r, r1, r2, r3, s1, s2
c совпадающие корни характеристического многочлена
r = d*d - 4*c*c
if ( r .ne. 0.) go to 1
det = ((d/2.)**n)*( 1. + n )
go to 3
c различные вещественные корни характеристического многочлена
1 if ( r .lt. 0.) go to 2
r1 = dsqrt( r )
r2 = ( d + r1 )
r3 = ( d - r1 )
s1 = r2**(n+1)
s2 = r3**(n+1)
p = 2.**(n+1)
det = ( s1 - s2 )/( p*r1)
go to 3
c мнимые корни характеристического многочлена
2 r = c**n
r1 = d/( 2 * c )
fi = dacos( r1 )
r2 = dsin( ( n + 1.)*fi)
r3 = dsin(fi)
det = r * r2/r3
3 return
end

2. Программа вычисления обратных матриц на Фортране

double precision ua( 3, 3 ), e( 3, 3 )
d = 2.
c = 1.
n = 3
call ais5d( d, c, n, ua, ierr )
write(*,33) d, c, n, ierr, ua
33 FORMAT(2x,'d, c, n, ierr, ua', 2X, 2E12.4, 2I4,/(3E12.4/))
do 2 i = 1, n
do 1 j = 1, n
if( i .eq. 1) e( i, j ) = d*ua(i,j) + c*ua(i+1,j)
if( i .eq. n) e( i, j ) = c*ua(i-1,j) + d*ua(i,j)
if( i .ne. 1 .and. i .ne. n)
1 e( i, j ) = c*ua(i-1,j) + d*ua(i,j) + c*ua(i+1,j)
1 continue
2 continue
write(*,34) d, c, n, e
34 FORMAT(2x,'d, c, n, e', 2X, 2E12.4, I4,/(3E12.4/))
stop
END



subroutine ais5d( d, c, n, ua, ierr )
c Вычисление обратной матрицы для
c симметричной якобиевой матрицы
c с одинаковыми диагональными элементами.
c
c Параметры программы:
c d - диагональный элемент
c c - внедиагональный элемент
c n - порядок матрицы
c ua(n,n) - двумерный массив элементов обратной матрицы
c ierr - признак, равный 1, если матрица вырождена
c и 0 в противном случае
c
integer n, ierr, j, k
real d, c, eps
double precision ua(n,n), c1, c2, q1, q2
double precision fi, r, r1, r2, xjk
eps = 1.e-10
ierr = 0
r = d*d - 4*c*c
c совпадающие корни характеристического многочлена
if ( abs(r). gt. eps) go to 3
q1 = -d/(2.*c)
do 2 j = 1, n
do 1 k = 1, n
r = q1**( k - j + 1 )
r1 = c*( j*q1*q1 - j + n + 1 )
xjk = r/r1
if ( k .ge. j ) go to 13
xjk = xjk * ( j - n - 1 )*k
go to 14
13 xjk = xjk * ( k - n - 1 )*j
14 ua( j, k) = xjk
1 continue
2 continue
return
c различные вещественные корни характеристического многочлена
3 if ( d*d .lt. 4*c*c ) go to 6
r1 = sqrt( d*d - 4.*c*c )
q1 = ( -d + r1 )/(2.*c)
q2 = ( -d - r1 )/(2.*c)
r1 = q1**( n+1 )
r2 = q2**( n+1 )
c1 = -1./( c*( q1 - q2 ) * ( r1 - r2 ))
do 5 j = 1, n
r1 = q1**( n+1-j )
r2 = q2**( n+1-j )
c2 = c1*( r1 - r2 )
do 4 k = 1, n
r1 = q1**k
r2 = q2**k
xjk = c2*( r1 - r2 )
ua( k, j ) = xjk
if ( k .le. j ) go to 4
r1 = q1**( k-j )
r2 = q2**( k-j )
xjk = xjk + ( r1 - r2 )/( c * ( q1 - q2 ) )
ua ( k , j ) = xjk
4 continue
5 continue
return
c мнимые корни характеристического многочлена
6 r1 = -d/( 2 * c )
fi = dacos( r1 )
do 8 j = 1, n
do 7 k = 1, n
r1 = c*dsin( fi )*dsin( (n + 1)*fi )
if( abs(r1).gt.eps ) go to 16
write(*,33)
33 FORMAT(2x,'матрица вырождена')
ierr = 1
return
16 xjk = -dsin(( n + 1 - j )*fi)*dsin( k*fi )/r1
if ( k .gt. j )
1 xjk = xjk + ( 1./c )*dsin( (k - j)*fi )/dsin( fi )
ua(k, j ) = xjk
7 continue
8 continue
9 return
end

3. Программа вычисления собственных значений на Фортране

double precision ld( 5 )
d = 0.
c = 0.5
n = 5
call aes5d( d, c, n, ld )
write(*,33) d, c, n, ld
33 FORMAT(2x,'d, c, n, ld', 2X, 2E12.4, I4,/5E12.4/)
stop
END

subroutine aes5d( d, c, n, ld )
c Вычисление собственных значений для
c симметричной якобиевой матрицы
c с одинаковыми диагональными элементами.
c
c Параметры программы:
c d - диагональный элемент
c c - внедиагональный элемент
c n - порядок матрицы
c ld(n) - одномерный массив собственных значений, расположенных в
с порядке возрастания
c
integer n, k
real d, c
double precision ld(n), pi, pin1
pi = datan(1.)*4.
pin1=pi/(n+1)
if(c.lt.0.) goto 2
do 1 k= 1 , n
ld(k) = d - 2*c*dcos(pin1*k)
1 continue
goto 4
2 do 3 k= n,1,-1
ld(n-k+1) = d - 2*c*dcos(pin1*k)
3 continue
4 return
end

4. Программа вычисления собственных векторов на Фортране

double precision vld(5,5)
n = 5
call aes6d( n, vld )
write(*,33) n, vld
33 FORMAT(2x,' n, vld', 2X, I4,/(5E12.4/))
stop
END

subroutine aes6d( n, vld )
c Вычисление собственных векторов для
c симметричной якобиевой матрицы
c с одинаковыми диагональными элементами.
c
c Параметры программы:
c n - порядок матрицы
c vld(n,n) - двумерный массив собственных векторов, соответствующих
с собственным значениям, расположенным в порядке возрасрания
c
integer j, k
double precision vld( n,n ), a, fik, fik_j, a1, pi
pi = datan(1.)*4.
do 2 k=1, n
vld(k,1)=1.
fik = pi*k/(n + 1.)
a1 = sin(fik)
do 1 j=2, n
fik_j = fik*j
a = sin(fik_j)
vld(k,j) = (-1)**(j+1)*a/a1
1 continue
2 continue
return
end