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 REAL RW( 2*NMAX )
77 COMPLEX 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 cmplx
98
99
100
101 nout = nunit
102 c2 = path( 2: 3 )
103 lw = nmax + 1
104 a( 1, 1 ) = cmplx( 1.0e+0, -1.0e+0 )
105 a( 1, 2 ) = cmplx( 2.0e+0, -2.0e+0 )
106 a( 2, 2 ) = cmplx( 3.0e+0, -3.0e+0 )
107 a( 2, 1 ) = cmplx( 4.0e+0, -4.0e+0 )
108 ok = .true.
109 WRITE( nout, fmt = * )
110
111
112
113 IF(
lsamen( 2, c2,
'QP' ) )
THEN
114
115
116
117 srnamt = 'CGEQP3'
118 infot = 1
119 CALL cgeqp3( -1, 0, a, 1, ip, tau, w, lw, rw, info )
120 CALL chkxer(
'CGEQP3', infot, nout, lerr, ok )
121 infot = 2
122 CALL cgeqp3( 1, -1, a, 1, ip, tau, w, lw, rw, info )
123 CALL chkxer(
'CGEQP3', infot, nout, lerr, ok )
124 infot = 4
125 CALL cgeqp3( 2, 3, a, 1, ip, tau, w, lw, rw, info )
126 CALL chkxer(
'CGEQP3', infot, nout, lerr, ok )
127 infot = 8
128 CALL cgeqp3( 2, 2, a, 2, ip, tau, w, lw-10, rw, info )
129 CALL chkxer(
'CGEQP3', 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 cgeqp3(m, n, a, lda, jpvt, tau, work, lwork, rwork, info)
CGEQP3
logical function lsamen(n, ca, cb)
LSAMEN