実一般行列の特異値主要項

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

Keyword: 実一般行列, 特異値主要項

概要

本サンプルは実一般行列の特異値主要項を求めるFortranによるサンプルプログラムです。 本サンプルは2次元カーネルが以下の式で示される場合の有限差分の離散化から得られる100x500の実行列の最大特異値4つを求めて出力します。

実行列のデータ 

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

入力データ

(本ルーチンの詳細はf02wgf のマニュアルページを参照)
1
2

このデータをダウンロード
F02WGF Example Program Data
 100 500 4 10         : m, n, k, ncv

  • 1行目はタイトル行で読み飛ばされます。
  • 2行目に行列Aの行数(m)、列数(n)、特異値の数(k)、特異値と残差の配列の次数(ncv)を指定しています。

出力結果

(本ルーチンの詳細はf02wgf のマニュアルページを参照)
1
2
3
4
5
6
7

この出力例をダウンロード
 F02WGF Example Program Results

   Singular Value    Residual
    0.00830          0.36E-17
    0.01223          0.24E-17
    0.02381          0.15E-16
    0.11274          0.29E-16

  • 4~7行目に特異値と残差が出力されています。

ソースコード

(本ルーチンの詳細はf02wgf のマニュアルページを参照)

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116

このソースコードをダウンロード
!   F02WGF Example Program Text
!   Mark 23 Release. nAG Copyright 2011.

    MODULE f02wgfe_mod

!      F02WGF Example Program Module:
!             Parameters and User-defined Routines

!      .. Use Statements ..
       USE nag_library, ONLY : nag_wp
!      .. Implicit None Statement ..
       IMPLICIT NONE
!      .. Parameters ..
       INTEGER, PARAMETER                  :: nin = 5, nout = 6
    CONTAINS
!      Matrix vector subroutines

       SUBROUTINE av(iflag,m,n,x,ax,iuser,ruser)

!         Computes  w <- A*x or w <- Trans(A)*x.

!         .. Implicit None Statement ..
          IMPLICIT NONE
!         .. Parameters ..
          REAL (KIND=nag_wp), PARAMETER       :: one = 1.0_nag_wp
          REAL (KIND=nag_wp), PARAMETER       :: zero = 0.0_nag_wp
!         .. Scalar Arguments ..
          INTEGER, INTENT (INOUT)             :: iflag
          INTEGER, INTENT (IN)                :: m, n
!         .. Array Arguments ..
          REAL (KIND=nag_wp), INTENT (INOUT)  :: ax(*), ruser(*)
          REAL (KIND=nag_wp), INTENT (IN)     :: x(*)
          INTEGER, INTENT (INOUT)             :: iuser(*)
!         .. Local Scalars ..
          REAL (KIND=nag_wp)                  :: h, k, s, t
          INTEGER                             :: i, j
!         .. Intrinsic Functions ..
          INTRINSIC                              min, real
!         .. Executable Statements ..
          h = one/real(m+1,kind=nag_wp)
          k = one/real(n+1,kind=nag_wp)
          IF (iflag==1) THEN
             ax(1:m) = zero
             t = zero

             DO j = 1, n
                t = t + k
                s = zero
                DO i = 1, min(j,m)
                   s = s + h
                   ax(i) = ax(i) + k*s*(t-one)*x(j)
                END DO
                DO i = j + 1, m
                   s = s + h
                   ax(i) = ax(i) + k*t*(s-one)*x(j)
                END DO
             END DO
          ELSE
             ax(1:n) = zero
             t = zero

             DO j = 1, n
                t = t + k
                s = zero
                DO i = 1, min(j,m)
                   s = s + h
                   ax(j) = ax(j) + k*s*(t-one)*x(i)
                END DO
                DO i = j + 1, m
                   s = s + h
                   ax(j) = ax(j) + k*t*(s-one)*x(i)
                END DO
             END DO
          END IF

          RETURN
       END SUBROUTINE av
    END MODULE f02wgfe_mod
    PROGRAM f02wgfe

!      F02WGF Example Main Program

!      .. Use Statements ..
       USE nag_library, ONLY : f02wgf, nag_wp
       USE f02wgfe_mod, ONLY : av, nin, nout
!      .. Implicit None Statement ..
       IMPLICIT NONE
!      .. Local Scalars ..
       INTEGER                             :: i, ifail, k, ldu, ldv, m, n,     &
                                              nconv, ncv
!      .. Local Arrays ..
       REAL (KIND=nag_wp), ALLOCATABLE     :: resid(:), sigma(:), u(:,:), v(:,:)
       REAL (KIND=nag_wp)                  :: ruser(1)
       INTEGER                             :: iuser(1)
!      .. Executable Statements ..
       WRITE (nout,*) 'F02WGF Example Program Results'
       WRITE (nout,*)
!      Skip heading in data file
       READ (nin,*)
       READ (nin,*) m, n, k, ncv
       ldu = m
       ldv = n
       ALLOCATE (resid(ncv),sigma(ncv),u(ldu,ncv),v(ldv,ncv))

!      ifail: behaviour on error exit
!             =0 for hard exit, =1 for quiet-soft, =-1 for noisy-soft
       ifail = 0
       CALL f02wgf(m,n,k,ncv,av,nconv,sigma,u,ldu,v,ldv,resid,iuser,ruser, &
          ifail)

!      Print computed residuals
       WRITE (nout,*) '  Singular Value    Residual'
       WRITE (nout,99999) (sigma(i),resid(i),i=1,nconv)

99999  FORMAT (1X,F10.5,8X,G10.2)
    END PROGRAM f02wgfe


関連情報
© 日本ニューメリカルアルゴリズムズグループ株式会社 2025
Privacy Policy  /  Trademarks