47
48
49
50
51
52
53 INTEGER NUNIT
54
55
56
57
58
59 INTEGER NMAX
60 parameter( nmax = 4 )
61
62
63 INTEGER I, INFO, ITER, J
64
65
66 INTEGER IP( NMAX )
67 COMPLEX*16 A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
68 $ C( NMAX ), R( NMAX ), R1( NMAX ), R2( NMAX ),
69 $ W( 2*NMAX ), X( NMAX )
70 COMPLEX*16 WORK(1)
71 COMPLEX SWORK(1)
72 DOUBLE PRECISION RWORK(1)
73
74
75
76
78
79
80 LOGICAL LERR, OK
81 CHARACTER*32 SRNAMT
82 INTEGER INFOT, NOUT
83
84
85 COMMON / infoc / infot, nout, ok, lerr
86 COMMON / srnamc / srnamt
87
88
89 INTRINSIC dble
90
91
92
93 nout = nunit
94 WRITE( nout, fmt = * )
95
96
97
98 DO 20 j = 1, nmax
99 DO 10 i = 1, nmax
100 a( i, j ) = 1.d0 / dble( i+j )
101 af( i, j ) = 1.d0 / dble( i+j )
102 10 CONTINUE
103 b( j ) = 0.d0
104 r1( j ) = 0.d0
105 r2( j ) = 0.d0
106 w( j ) = 0.d0
107 x( j ) = 0.d0
108 c( j ) = 0.d0
109 r( j ) = 0.d0
110 ip( j ) = j
111 20 CONTINUE
112 ok = .true.
113
114 srnamt = 'ZCGESV'
115 infot = 1
116 CALL zcgesv(-1,0,a,1,ip,b,1,x,1,work,swork,rwork,iter,info)
117 CALL chkxer(
'ZCGESV', infot, nout, lerr, ok )
118 infot = 2
119 CALL zcgesv(0,-1,a,1,ip,b,1,x,1,work,swork,rwork,iter,info)
120 CALL chkxer(
'ZCGESV', infot, nout, lerr, ok )
121 infot = 4
122 CALL zcgesv(2,1,a,1,ip,b,2,x,2,work,swork,rwork,iter,info)
123 CALL chkxer(
'ZCGESV', infot, nout, lerr, ok )
124 infot = 7
125 CALL zcgesv(2,1,a,2,ip,b,1,x,2,work,swork,rwork,iter,info)
126 CALL chkxer(
'ZCGESV', infot, nout, lerr, ok )
127 infot = 9
128 CALL zcgesv(2,1,a,2,ip,b,2,x,1,work,swork,rwork,iter,info)
129 CALL chkxer(
'ZCGESV', infot, nout, lerr, ok )
130
131
132
133 IF( ok ) THEN
134 WRITE( nout, fmt = 9999 )'ZCGESV'
135 ELSE
136 WRITE( nout, fmt = 9998 )'ZCGESV'
137 END IF
138
139 9999 FORMAT( 1x, a6, ' drivers passed the tests of the error exits' )
140 9998 FORMAT( ' *** ', a6, ' drivers failed the tests of the error ',
141 $ 'exits ***' )
142
143 RETURN
144
145
146
subroutine chkxer(srnamt, infot, nout, lerr, ok)
subroutine zcgesv(n, nrhs, a, lda, ipiv, b, ldb, x, ldx, work, swork, rwork, iter, info)
ZCGESV computes the solution to system of linear equations A * X = B for GE matrices (mixed precision...