25 INTEGER cores, m, n, nrhs
26 parameter( cores = 2 )
31 parameter( zone = ( 1.0d+0, 0.0d+0 ) )
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 ))
39 DOUBLE PRECISION xnorm, anorm, bnorm, rnorm, eps
44 DOUBLE PRECISION dlamch, dlange
45 EXTERNAL zlarnv, dlamch, dlange
48 EXTERNAL plasma_dealloc_handle
63 WRITE(*,*)
"-- PLASMA is initialized on", cores,
"cores."
67 CALL zlarnv( 1, iseed, m*n, a1 )
72 CALL zlarnv( 1, iseed,
max(m,n)*nrhs, b1 )
82 & a2, m, ht, b2,
max(m,n), info )
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)
90 CALL dgemm(
'No transpose',
'No transpose', m, nrhs, n, zone,
91 $ a1, m, b2,
max(m,n), -zone, b1,
max(m,n))
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)
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)
103 eps= dlamch(
'Epsilon')
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)
110 IF ((rnorm > 60.0).AND.( info < 0 ))
THEN
111 WRITE(*,*)
"-- Error in DGELS example !"
113 WRITE(*,*)
"-- Run of DGELS example successful !"
118 CALL plasma_dealloc_handle( ht, info )