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