実多項式の根

ホーム > 製品 > nAG数値計算ライブラリ > nAG Fortranライブラリ > サンプルソースコード集 > 実多項式の根

Keyword: 実多項式の根

概要

本サンプルは実多項式の根を求めるFortranによるサンプルプログラムです。本サンプルでは一つ目の例で以下に示される次数が5の多項式の根を求めて出力します。二つ目の例では同じ問題を解き求められた解の誤差推定を出力します。

実多項式の根のデータ　

※本サンプルはnAG Fortranライブラリに含まれるルーチン c02agf() のExampleコードです。本サンプル及びルーチンの詳細情報は c02agf のマニュアルページをご参照ください。
ご相談やお問い合わせはこちらまで

入力データ

このデータをダウンロード

C02AGF Example Program Data

Example 1
 5
     1.0    2.0    3.0    4.0    5.0    6.0

Example 2
 5
     1.0    2.0    3.0    4.0    5.0    6.0

１行目はタイトル行で読み飛ばされます。
４行目に一つ目の例の多項式の次数(n)を指定しています。
５行目に一つ目の例の各項の係数(a)を指定しています。
８行目に二つ目の例の多項式の次数(n)を指定しています。
９行目に二つ目の例の各項の係数(a)を指定しています。

出力結果

（本ルーチンの詳細はc02agf のマニュアルページを参照）

この出力例をダウンロード

 C02AGF Example Program Results


 Example 1


 Degree of polynomial =    5

 Computed roots of polynomial

 z =  -1.4918E+00
 z =   5.5169E-01 +/-   1.2533E+00*i
 z =  -8.0579E-01 +/-   1.2229E+00*i


 Example 2

 Degree of polynomial =    5

 Computed roots of polynomial     Error estimates
                                (machine-dependent)

 z =  -1.4918E+00 +0.0000E+00*i       1.2E-15
 z =   5.5169E-01 +1.2533E+00*i       1.1E-16
 z =   5.5169E-01 -1.2533E+00*i       1.1E-16
 z =  -8.0579E-01 +1.2229E+00*i       1.5E-16
 z =  -8.0579E-01 -1.2229E+00*i       1.5E-16

７行目に一つ目の例の入力された多項式の次数が出力されています。
１１～１３行目に一つ目の例の多項式の根（実部と虚部）が出力されています。
１８行目に二つ目の例の入力された多項式の次数が出力されています。
２３～２７行目に二つ目の例の多項式の根（実部と虚部）と誤差推定が出力されています。

ソースコード

（本ルーチンの詳細はc02agf のマニュアルページを参照）

※本サンプルソースコードは科学技術・統計計算ライブラリである「nAG Fortranライブラリ」のルーチンを呼び出します。
サンプルのコンパイル及び実行方法

このソースコードをダウンロード

!   C02AGF Example Program Text
!   Mark 23 Release. nAG Copyright 2011.

    MODULE c02agfe_mod

!      C02AGF Example Program Module: Parameters

!      .. Implicit None Statement ..
       IMPLICIT NONE
!      .. Parameters ..
       INTEGER, PARAMETER              :: nin = 5, nout = 6
       LOGICAL, PARAMETER              :: scal = .TRUE.
    END MODULE c02agfe_mod
    PROGRAM c02agfe

!      C02AGF Example Main Program

!      .. Use Statements ..
       USE c02agfe_mod, ONLY : nout
!      .. Implicit None Statement ..
       IMPLICIT NONE
!      .. External Subroutines ..
       EXTERNAL                           ex1, ex2
!      .. Executable Statements ..
       WRITE (nout,*) 'C02AGF Example Program Results'

       CALL ex1
       CALL ex2

    END PROGRAM c02agfe
    SUBROUTINE ex1

!      .. Use Statements ..
       USE nag_library, ONLY : c02agf, nag_wp
       USE c02agfe_mod, ONLY : nin, nout, scal
!      .. Implicit None Statement ..
       IMPLICIT NONE
!      .. Local Scalars ..
       REAL (KIND=nag_wp)              :: zi, zr
       INTEGER                         :: i, ifail, n, nroot
!      .. Local Arrays ..
       REAL (KIND=nag_wp), ALLOCATABLE :: a(:), w(:), z(:,:)
!      .. Intrinsic Functions ..
       INTRINSIC                          abs
!      .. Executable Statements ..
       WRITE (nout,*)
       WRITE (nout,*)
       WRITE (nout,*) 'Example 1'

!      Skip heading in data file
       READ (nin,*)
       READ (nin,*)
       READ (nin,*)

       READ (nin,*) n
       ALLOCATE (a(0:n),w(2*(n+1)),z(2,n))

       READ (nin,*) (a(i),i=0,n)

       WRITE (nout,*)
       WRITE (nout,99999) 'Degree of polynomial = ', n

       ifail = 0
       CALL c02agf(a,n,scal,z,w,ifail)

       WRITE (nout,99998) 'Computed roots of polynomial'

       nroot = 1

       DO WHILE (nroot<=n)

          zr = z(1,nroot)
          zi = z(2,nroot)
          IF (zi==0.0E0_nag_wp) THEN
             WRITE (nout,99997) 'z = ', zr
             nroot = nroot + 1
          ELSE
             WRITE (nout,99997) 'z = ', zr, ' +/- ', abs(zi), '*i'
             nroot = nroot + 2
          END IF

       END DO

99999  FORMAT (/1X,A,I4)
99998  FORMAT (/1X,A/)
99997  FORMAT (1X,A,1P,E12.4,A,E12.4,A)
    END SUBROUTINE ex1
    SUBROUTINE ex2

!      .. Use Statements ..
       USE nag_library, ONLY : a02abf, c02agf, nag_wp, x02ajf, x02alf
       USE c02agfe_mod, ONLY : nin, nout, scal
!      .. Implicit None Statement ..
       IMPLICIT NONE
!      .. Local Scalars ..
       REAL (KIND=nag_wp)              :: deltac, deltai, di, eps, epsbar, f,  &
                                          r1, r2, r3, rmax
       INTEGER                         :: i, ifail, j, jmin, n
!      .. Local Arrays ..
       REAL (KIND=nag_wp), ALLOCATABLE :: a(:), abar(:), r(:), w(:), z(:,:),   &
                                          zbar(:,:)
       INTEGER, ALLOCATABLE            :: m(:)
!      .. Intrinsic Functions ..
       INTRINSIC                          abs, max, min
!      .. Executable Statements ..
       WRITE (nout,*)
       WRITE (nout,*)
       WRITE (nout,*) 'Example 2'

!      Skip heading in data file
       READ (nin,*)
       READ (nin,*)

       READ (nin,*) n
       ALLOCATE (a(0:n),abar(0:n),r(n),w(2*(n+1)),z(2,n),zbar(2,n),m(n))

!      Read in the coefficients of the original polynomial.

       READ (nin,*) (a(i),i=0,n)

!      Compute the roots of the original polynomial.

       ifail = 0
       CALL c02agf(a,n,scal,z,w,ifail)

!      Form the coefficients of the perturbed polynomial.

       eps = x02ajf()
       epsbar = 3.0_nag_wp*eps

       DO i = 0, n

          IF (a(i)/=0.0_nag_wp) THEN
             f = 1.0_nag_wp + epsbar
             epsbar = -epsbar
             abar(i) = f*a(i)
          ELSE
             abar(i) = 0.0E0_nag_wp
          END IF

       END DO

!      Compute the roots of the perturbed polynomial.

       ifail = 0
       CALL c02agf(abar,n,scal,zbar,w,ifail)

!      Perform error analysis.

!      Initialize markers to 0 (unmarked).

       m(1:n) = 0

       rmax = x02alf()

!      Loop over all unperturbed roots (stored in Z).

       DO i = 1, n
          deltai = rmax
          r1 = a02abf(z(1,i),z(2,i))

!         Loop over all perturbed roots (stored in ZBAR).

          DO j = 1, n

!            Compare the current unperturbed root to all unmarked
!            perturbed roots.

             IF (m(j)==0) THEN
                r2 = a02abf(zbar(1,j),zbar(2,j))
                deltac = abs(r1-r2)

                IF (deltac<deltai) THEN
                   deltai = deltac
                   jmin = j
                END IF

             END IF

          END DO

!         Mark the selected perturbed root.

          m(jmin) = 1

!         Compute the relative error.

          IF (r1/=0.0E0_nag_wp) THEN
             r3 = a02abf(zbar(1,jmin),zbar(2,jmin))
             di = min(r1,r3)
             r(i) = max(deltai/max(di,deltai/rmax),eps)
          ELSE
             r(i) = 0.0_nag_wp
          END IF

       END DO

       WRITE (nout,*)
       WRITE (nout,99999) 'Degree of polynomial = ', n
       WRITE (nout,*)
       WRITE (nout,*) 'Computed roots of polynomial   ', '  Error estimates'
       WRITE (nout,*) '                            ', '   (machine-dependent)'
       WRITE (nout,*)

       DO i = 1, n
          WRITE (nout,99998) 'z = ', z(1,i), z(2,i), '*i', r(i)
       END DO

99999  FORMAT (1X,A,I4)
99998  FORMAT (1X,A,1P,E12.4,SP,E12.4,A,5X,SS,E9.1)
    END SUBROUTINE ex2

Fortranによるサンプルソースコード : 使用ルーチン名：c02agf

概要

入力データ

出力結果

ソースコード