PLASMA  2.4.5
PLASMA - Parallel Linear Algebra for Scalable Multi-core Architectures
 All Data Structures Namespaces Files Functions Variables Typedefs Enumerations Enumerator Macros Groups
example_dgels_f.f
Go to the documentation of this file.
2 *
3 *********************************************************************
4 * PLASMA example routine (version 2.4.5)
5 * Author: Bilel Hadri
6 * Release Date: November, 15th 2010
7 * PLASMA is a software package provided by Univ. of Tennessee,
8 * Univ. of California Berkeley and Univ. of Colorado Denver.
9 * @generated d Tue Nov 22 14:35:54 2011
10 *********************************************************************
11 *
12  IMPLICIT NONE
13 *
14  include "plasmaf.h"
15 *
16 * Purpose
17 * =======
18 *
19 * FORTRAN EXAMPLE FOR PLASMA_DGELS
20 * Example for solving a system of linear equations using QR factorization
21 *
22 * =====================================================================
23 *
24 * .. Parameters ..
25  INTEGER cores, m, n, nrhs
26  parameter( cores = 2 )
27  parameter( m = 20 )
28  parameter( n = 15 )
29  parameter( nrhs = 5 )
30  COMPLEX*16 zone
31  parameter( zone = ( 1.0d+0, 0.0d+0 ) )
32 * ..
33 * .. Local Scalars ..
34  COMPLEX*16 a1( m, n ), b1( max(m,n), nrhs )
35  COMPLEX*16 a2( m, n ), b2( max(m,n), nrhs )
36  COMPLEX*16 risu( max(m,n), nrhs)
37  DOUBLE PRECISION rwork( max(m,n ))
38  INTEGER ht( 2 )
39  DOUBLE PRECISION xnorm, anorm, bnorm, rnorm, eps
40  INTEGER i, info
41  INTEGER iseed( 4 )
42 * ..
43 * .. External Subroutines ..
44  DOUBLE PRECISION dlamch, dlange
45  EXTERNAL zlarnv, dlamch, dlange
48  EXTERNAL plasma_dealloc_handle
49  EXTERNAL dgemm
50 * ..
51 * .. Intrinsic Functions ..
52  INTRINSIC max, min
53 * ..
54 * .. Executable Statements ..
55 *
56  DO i = 1, 4
57  iseed( i ) = 1
58  ENDDO
59 *
60 * Initialize Plasma
61 *
62  CALL plasma_init( cores, info )
63  WRITE(*,*) "-- PLASMA is initialized on", cores, "cores."
64 *
65 * Initialization of the matrix
66 *
67  CALL zlarnv( 1, iseed, m*n, a1 )
68  a2(:,:)=a1(:,:)
69 *
70 * Initialization of the RHS
71 *
72  CALL zlarnv( 1, iseed, max(m,n)*nrhs, b1 )
73  b2(:,:)=b1(:,:)
74 *
75 * Allocate T
76 *
77  CALL plasma_alloc_workspace_dgels( m, n, ht, info )
78 *
79 * Perform the QR solve
80 *
81  CALL plasma_dgels( plasmanotrans, m, n, nrhs,
82  & a2, m, ht, b2, max(m,n), info )
83 *
84 * Check the solution
85 *
86  xnorm = dlange('I',min(m,n), nrhs, b2, min(m,n), rwork)
87  anorm = dlange('I',m, n, a1, m, rwork)
88  bnorm = dlange('I',min(m,n), nrhs, b1, min(m,n), rwork)
89 
90  CALL dgemm('No transpose','No transpose', m, nrhs, n, zone,
91  $ a1, m, b2, max(m,n), -zone, b1, max(m,n))
92 
93  IF (m >=n ) THEN
94  CALL dgemm('ConjTranspose','No transpose', n, nrhs, m, zone,
95  $ a1, m, b1, max(m,n), -zone, risu, m)
96  rnorm = dlange('I', m, nrhs, risu, n, rwork)
97  ELSE
98  CALL dgemm('ConjTranspose','No transpose', n, nrhs, m, zone,
99  $ a1, m, b1, max(m,n), -zone, risu, n)
100  rnorm = dlange('I', n, nrhs, risu, n, rwork)
101  ENDIF
102 
103  eps= dlamch('Epsilon')
104 
105  WRITE(*,*) '============'
106  WRITE(*,*) 'Checking the Residual of the solution '
107  WRITE(*,*) '-- ||Ax-B||_oo/((||A||_oo||x||_oo+||B||_oo).N.eps)=',
108  $ rnorm / ((anorm * xnorm + bnorm) * n * eps)
109 
110  IF ((rnorm > 60.0).AND.( info < 0 )) THEN
111  WRITE(*,*) "-- Error in DGELS example !"
112  ELSE
113  WRITE(*,*) "-- Run of DGELS example successful !"
114  ENDIF
115 *
116 * Deallocate T
117 *
118  CALL plasma_dealloc_handle( ht, info )
119 *
120 * Finalize Plasma
121 *
122  CALL plasma_finalize( info )
123 *
124 * End of EXAMPLE_DGELS.
125 *
126  END PROGRAM example_dgels_f