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 A( NMAX, NMAX ), TAU( NMAX ), W( 3*NMAX+1 )
77
78
79 LOGICAL LSAMEN
81
82
84
85
86 LOGICAL LERR, OK
87 CHARACTER*32 SRNAMT
88 INTEGER INFOT, NOUT
89
90
91 COMMON / infoc / infot, nout, ok, lerr
92 COMMON / srnamc / srnamt
93
94
95
96 nout = nunit
97 WRITE( nout, fmt = * )
98 c2 = path( 2: 3 )
99 lw = 3*nmax + 1
100 a( 1, 1 ) = 1.0d+0
101 a( 1, 2 ) = 2.0d+0
102 a( 2, 2 ) = 3.0d+0
103 a( 2, 1 ) = 4.0d+0
104 ok = .true.
105
106 IF(
lsamen( 2, c2,
'QP' ) )
THEN
107
108
109
110
111
112 srnamt = 'DGEQP3'
113 infot = 1
114 CALL dgeqp3( -1, 0, a, 1, ip, tau, w, lw, info )
115 CALL chkxer(
'DGEQP3', infot, nout, lerr, ok )
116 infot = 2
117 CALL dgeqp3( 1, -1, a, 1, ip, tau, w, lw, info )
118 CALL chkxer(
'DGEQP3', infot, nout, lerr, ok )
119 infot = 4
120 CALL dgeqp3( 2, 3, a, 1, ip, tau, w, lw, info )
121 CALL chkxer(
'DGEQP3', infot, nout, lerr, ok )
122 infot = 8
123 CALL dgeqp3( 2, 2, a, 2, ip, tau, w, lw-10, info )
124 CALL chkxer(
'DGEQP3', infot, nout, lerr, ok )
125 END IF
126
127
128
129 CALL alaesm( path, ok, nout )
130
131 RETURN
132
133
134
subroutine alaesm(path, ok, nout)
ALAESM
subroutine chkxer(srnamt, infot, nout, lerr, ok)
subroutine dgeqp3(m, n, a, lda, jpvt, tau, work, lwork, info)
DGEQP3
logical function lsamen(n, ca, cb)
LSAMEN