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 COMPLEX*16 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 INTRINSIC dcmplx
95
96
97
98 nout = nunit
99 c2 = path( 2: 3 )
100 a( 1, 1 ) = dcmplx( 1.d+0, -1.d+0 )
101 a( 1, 2 ) = dcmplx( 2.d+0, -2.d+0 )
102 a( 2, 2 ) = dcmplx( 3.d+0, -3.d+0 )
103 a( 2, 1 ) = dcmplx( 4.d+0, -4.d+0 )
104 w( 1 ) = dcmplx( 0.d+0, 0.d+0 )
105 w( 2 ) = dcmplx( 0.d+0, 0.d+0 )
106 ok = .true.
107
108
109 WRITE( nout, fmt = * )
110 IF(
lsamen( 2, c2,
'TZ' ) )
THEN
111
112
113
114
115 srnamt = 'ZTZRZF'
116 infot = 1
117 CALL ztzrzf( -1, 0, a, 1, tau, w, 1, info )
118 CALL chkxer(
'ZTZRZF', infot, nout, lerr, ok )
119 infot = 2
120 CALL ztzrzf( 1, 0, a, 1, tau, w, 1, info )
121 CALL chkxer(
'ZTZRZF', infot, nout, lerr, ok )
122 infot = 4
123 CALL ztzrzf( 2, 2, a, 1, tau, w, 1, info )
124 CALL chkxer(
'ZTZRZF', infot, nout, lerr, ok )
125 infot = 7
126 CALL ztzrzf( 2, 2, a, 2, tau, w, 0, info )
127 CALL chkxer(
'ZTZRZF', infot, nout, lerr, ok )
128 infot = 7
129 CALL ztzrzf( 2, 3, a, 2, tau, w, 1, info )
130 CALL chkxer(
'ZTZRZF', infot, nout, lerr, ok )
131 END IF
132
133
134
135 CALL alaesm( path, ok, nout )
136
137 RETURN
138
139
140
subroutine alaesm(path, ok, nout)
ALAESM
subroutine chkxer(srnamt, infot, nout, lerr, ok)
logical function lsamen(n, ca, cb)
LSAMEN
subroutine ztzrzf(m, n, a, lda, tau, work, lwork, info)
ZTZRZF