概要
本サンプルはFortran言語によりLAPACKルーチンDGGGLMを利用するサンプルプログラムです。
加重線形最小二乗問題を解きます。
ここで

入力データ
(本ルーチンの詳細はDGGGLM のマニュアルページを参照)1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18
このデータをダウンロード |
DGGGLM Example Program Data 4 3 4 :Values of M, N and P -0.57 -1.28 -0.39 -1.93 1.08 -0.31 2.30 0.24 -0.40 -0.02 1.03 -1.43 :End of matrix A 0.50 0.00 0.00 0.00 0.00 1.00 0.00 0.00 0.00 0.00 2.00 0.00 0.00 0.00 0.00 5.00 :End of matrix B 1.32 -4.00 5.52 3.24 :End of vector d
出力結果
(本ルーチンの詳細はDGGGLM のマニュアルページを参照)1 2 3 4 5 6 7 8 9 10
この出力例をダウンロード |
DGGGLM Example Program Results Weighted least squares solution 1.9889 -1.0058 -2.9911 Residual vector -6.37E-04 -2.45E-03 -4.72E-03 7.70E-03 Square root of the residual sum of squares 9.38E-03
ソースコード
(本ルーチンの詳細はDGGGLM のマニュアルページを参照)※本サンプルソースコードのご利用手順は「サンプルのコンパイル及び実行方法」をご参照下さい。
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
このソースコードをダウンロード |
Program dggglm_example ! DGGGLM Example Program Text ! Copyright 2017, Numerical Algorithms Group Ltd. http://www.nag.com ! .. Use Statements .. Use blas_interfaces, Only: dnrm2 Use lapack_interfaces, Only: dggglm Use lapack_precision, Only: dp ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: nb = 64, nin = 5, nout = 6 ! .. Local Scalars .. Real (Kind=dp) :: rnorm Integer :: i, info, lda, ldb, lwork, m, n, p ! .. Local Arrays .. Real (Kind=dp), Allocatable :: a(:, :), b(:, :), d(:), work(:), x(:), & y(:) ! .. Executable Statements .. Write (nout, *) 'DGGGLM Example Program Results' Write (nout, *) ! Skip heading in data file Read (nin, *) Read (nin, *) m, n, p lda = m ldb = m lwork = n + m + nb*(m+p) Allocate (a(lda,n), b(ldb,p), d(m), work(lwork), x(n), y(p)) ! Read A, B and D from data file Read (nin, *)(a(i,1:n), i=1, m) Read (nin, *)(b(i,1:p), i=1, m) Read (nin, *) d(1:m) ! Solve the weighted least squares problem ! minimize ||inv(B)*(d - A*x)|| (in the 2-norm) Call dggglm(m, n, p, a, lda, b, ldb, d, x, y, work, lwork, info) ! Print least squares solution, x Write (nout, *) 'Weighted least squares solution' Write (nout, 100) x(1:n) ! Print residual vector y = inv(B)*(d - A*x) Write (nout, *) Write (nout, *) 'Residual vector' Write (nout, 110) y(1:p) ! Compute and print the square root of the residual sum of ! squares rnorm = dnrm2(p, y, 1) Write (nout, *) Write (nout, *) 'Square root of the residual sum of squares' Write (nout, 110) rnorm 100 Format (1X, 7F11.4) 110 Format (3X, 1P, 7E11.2) End Program