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

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