54
55
56
57
58
59
60 CHARACTER*3 PATH
61 INTEGER NUNIT
62
63
64
65
66
67 INTEGER NMAX
68 parameter( nmax = 3 )
69
70
71 CHARACTER*2 C2
72 INTEGER INFO, LW
73
74
75 INTEGER IP( NMAX )
76 DOUBLE PRECISION RW( 2*NMAX )
77 COMPLEX*16 A( NMAX, NMAX ), TAU( NMAX ),
78 $ W( 2*NMAX+3*NMAX )
79
80
81 LOGICAL LSAMEN
83
84
86
87
88 LOGICAL LERR, OK
89 CHARACTER*32 SRNAMT
90 INTEGER INFOT, NOUT
91
92
93 COMMON / infoc / infot, nout, ok, lerr
94 COMMON / srnamc / srnamt
95
96
97 INTRINSIC dcmplx
98
99
100
101 nout = nunit
102 c2 = path( 2: 3 )
103 lw = nmax + 1
104 a( 1, 1 ) = dcmplx( 1.0d+0, -1.0d+0 )
105 a( 1, 2 ) = dcmplx( 2.0d+0, -2.0d+0 )
106 a( 2, 2 ) = dcmplx( 3.0d+0, -3.0d+0 )
107 a( 2, 1 ) = dcmplx( 4.0d+0, -4.0d+0 )
108 ok = .true.
109 WRITE( nout, fmt = * )
110
111
112
113 IF(
lsamen( 2, c2,
'QP' ) )
THEN
114
115
116
117 srnamt = 'ZGEQP3'
118 infot = 1
119 CALL zgeqp3( -1, 0, a, 1, ip, tau, w, lw, rw, info )
120 CALL chkxer(
'ZGEQP3', infot, nout, lerr, ok )
121 infot = 2
122 CALL zgeqp3( 1, -1, a, 1, ip, tau, w, lw, rw, info )
123 CALL chkxer(
'ZGEQP3', infot, nout, lerr, ok )
124 infot = 4
125 CALL zgeqp3( 2, 3, a, 1, ip, tau, w, lw, rw, info )
126 CALL chkxer(
'ZGEQP3', infot, nout, lerr, ok )
127 infot = 8
128 CALL zgeqp3( 2, 2, a, 2, ip, tau, w, lw-10, rw, info )
129 CALL chkxer(
'ZGEQP3', infot, nout, lerr, ok )
130 END IF
131
132
133
134 CALL alaesm( path, ok, nout )
135
136 RETURN
137
138
139
subroutine alaesm(path, ok, nout)
ALAESM
subroutine chkxer(srnamt, infot, nout, lerr, ok)
subroutine zgeqp3(m, n, a, lda, jpvt, tau, work, lwork, rwork, info)
ZGEQP3
logical function lsamen(n, ca, cb)
LSAMEN