LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ check1()

subroutine check1 ( double precision  sfac)

Definition at line 76 of file c_zblat1.f.

77* .. Parameters ..
78 INTEGER NOUT
79 parameter(nout=6)
80* .. Scalar Arguments ..
81 DOUBLE PRECISION SFAC
82* .. Scalars in Common ..
83 INTEGER ICASE, INCX, INCY, MODE, N
84 LOGICAL PASS
85* .. Local Scalars ..
86 COMPLEX*16 CA
87 DOUBLE PRECISION SA
88 INTEGER I, J, LEN, NP1
89* .. Local Arrays ..
90 COMPLEX*16 CTRUE5(8,5,2), CTRUE6(8,5,2), CV(8,5,2), CX(8),
91 + MWPCS(5), MWPCT(5)
92 DOUBLE PRECISION STRUE2(5), STRUE4(5)
93 INTEGER ITRUE3(5)
94* .. External Functions ..
95 DOUBLE PRECISION DZASUMTEST, DZNRM2TEST
96 INTEGER IZAMAXTEST
97 EXTERNAL dzasumtest, dznrm2test, izamaxtest
98* .. External Subroutines ..
99 EXTERNAL zscaltest, zdscaltest, ctest, itest1, stest1
100* .. Intrinsic Functions ..
101 INTRINSIC max
102* .. Common blocks ..
103 COMMON /combla/icase, n, incx, incy, mode, pass
104* .. Data statements ..
105 DATA sa, ca/0.3d0, (0.4d0,-0.7d0)/
106 DATA ((cv(i,j,1),i=1,8),j=1,5)/(0.1d0,0.1d0),
107 + (1.0d0,2.0d0), (1.0d0,2.0d0), (1.0d0,2.0d0),
108 + (1.0d0,2.0d0), (1.0d0,2.0d0), (1.0d0,2.0d0),
109 + (1.0d0,2.0d0), (0.3d0,-0.4d0), (3.0d0,4.0d0),
110 + (3.0d0,4.0d0), (3.0d0,4.0d0), (3.0d0,4.0d0),
111 + (3.0d0,4.0d0), (3.0d0,4.0d0), (3.0d0,4.0d0),
112 + (0.1d0,-0.3d0), (0.5d0,-0.1d0), (5.0d0,6.0d0),
113 + (5.0d0,6.0d0), (5.0d0,6.0d0), (5.0d0,6.0d0),
114 + (5.0d0,6.0d0), (5.0d0,6.0d0), (0.1d0,0.1d0),
115 + (-0.6d0,0.1d0), (0.1d0,-0.3d0), (7.0d0,8.0d0),
116 + (7.0d0,8.0d0), (7.0d0,8.0d0), (7.0d0,8.0d0),
117 + (7.0d0,8.0d0), (0.3d0,0.1d0), (0.1d0,0.4d0),
118 + (0.4d0,0.1d0), (0.1d0,0.2d0), (2.0d0,3.0d0),
119 + (2.0d0,3.0d0), (2.0d0,3.0d0), (2.0d0,3.0d0)/
120 DATA ((cv(i,j,2),i=1,8),j=1,5)/(0.1d0,0.1d0),
121 + (4.0d0,5.0d0), (4.0d0,5.0d0), (4.0d0,5.0d0),
122 + (4.0d0,5.0d0), (4.0d0,5.0d0), (4.0d0,5.0d0),
123 + (4.0d0,5.0d0), (0.3d0,-0.4d0), (6.0d0,7.0d0),
124 + (6.0d0,7.0d0), (6.0d0,7.0d0), (6.0d0,7.0d0),
125 + (6.0d0,7.0d0), (6.0d0,7.0d0), (6.0d0,7.0d0),
126 + (0.1d0,-0.3d0), (8.0d0,9.0d0), (0.5d0,-0.1d0),
127 + (2.0d0,5.0d0), (2.0d0,5.0d0), (2.0d0,5.0d0),
128 + (2.0d0,5.0d0), (2.0d0,5.0d0), (0.1d0,0.1d0),
129 + (3.0d0,6.0d0), (-0.6d0,0.1d0), (4.0d0,7.0d0),
130 + (0.1d0,-0.3d0), (7.0d0,2.0d0), (7.0d0,2.0d0),
131 + (7.0d0,2.0d0), (0.3d0,0.1d0), (5.0d0,8.0d0),
132 + (0.1d0,0.4d0), (6.0d0,9.0d0), (0.4d0,0.1d0),
133 + (8.0d0,3.0d0), (0.1d0,0.2d0), (9.0d0,4.0d0)/
134 DATA strue2/0.0d0, 0.5d0, 0.6d0, 0.7d0, 0.7d0/
135 DATA strue4/0.0d0, 0.7d0, 1.0d0, 1.3d0, 1.7d0/
136 DATA ((ctrue5(i,j,1),i=1,8),j=1,5)/(0.1d0,0.1d0),
137 + (1.0d0,2.0d0), (1.0d0,2.0d0), (1.0d0,2.0d0),
138 + (1.0d0,2.0d0), (1.0d0,2.0d0), (1.0d0,2.0d0),
139 + (1.0d0,2.0d0), (-0.16d0,-0.37d0), (3.0d0,4.0d0),
140 + (3.0d0,4.0d0), (3.0d0,4.0d0), (3.0d0,4.0d0),
141 + (3.0d0,4.0d0), (3.0d0,4.0d0), (3.0d0,4.0d0),
142 + (-0.17d0,-0.19d0), (0.13d0,-0.39d0),
143 + (5.0d0,6.0d0), (5.0d0,6.0d0), (5.0d0,6.0d0),
144 + (5.0d0,6.0d0), (5.0d0,6.0d0), (5.0d0,6.0d0),
145 + (0.11d0,-0.03d0), (-0.17d0,0.46d0),
146 + (-0.17d0,-0.19d0), (7.0d0,8.0d0), (7.0d0,8.0d0),
147 + (7.0d0,8.0d0), (7.0d0,8.0d0), (7.0d0,8.0d0),
148 + (0.19d0,-0.17d0), (0.32d0,0.09d0),
149 + (0.23d0,-0.24d0), (0.18d0,0.01d0),
150 + (2.0d0,3.0d0), (2.0d0,3.0d0), (2.0d0,3.0d0),
151 + (2.0d0,3.0d0)/
152 DATA ((ctrue5(i,j,2),i=1,8),j=1,5)/(0.1d0,0.1d0),
153 + (4.0d0,5.0d0), (4.0d0,5.0d0), (4.0d0,5.0d0),
154 + (4.0d0,5.0d0), (4.0d0,5.0d0), (4.0d0,5.0d0),
155 + (4.0d0,5.0d0), (-0.16d0,-0.37d0), (6.0d0,7.0d0),
156 + (6.0d0,7.0d0), (6.0d0,7.0d0), (6.0d0,7.0d0),
157 + (6.0d0,7.0d0), (6.0d0,7.0d0), (6.0d0,7.0d0),
158 + (-0.17d0,-0.19d0), (8.0d0,9.0d0),
159 + (0.13d0,-0.39d0), (2.0d0,5.0d0), (2.0d0,5.0d0),
160 + (2.0d0,5.0d0), (2.0d0,5.0d0), (2.0d0,5.0d0),
161 + (0.11d0,-0.03d0), (3.0d0,6.0d0),
162 + (-0.17d0,0.46d0), (4.0d0,7.0d0),
163 + (-0.17d0,-0.19d0), (7.0d0,2.0d0), (7.0d0,2.0d0),
164 + (7.0d0,2.0d0), (0.19d0,-0.17d0), (5.0d0,8.0d0),
165 + (0.32d0,0.09d0), (6.0d0,9.0d0),
166 + (0.23d0,-0.24d0), (8.0d0,3.0d0),
167 + (0.18d0,0.01d0), (9.0d0,4.0d0)/
168 DATA ((ctrue6(i,j,1),i=1,8),j=1,5)/(0.1d0,0.1d0),
169 + (1.0d0,2.0d0), (1.0d0,2.0d0), (1.0d0,2.0d0),
170 + (1.0d0,2.0d0), (1.0d0,2.0d0), (1.0d0,2.0d0),
171 + (1.0d0,2.0d0), (0.09d0,-0.12d0), (3.0d0,4.0d0),
172 + (3.0d0,4.0d0), (3.0d0,4.0d0), (3.0d0,4.0d0),
173 + (3.0d0,4.0d0), (3.0d0,4.0d0), (3.0d0,4.0d0),
174 + (0.03d0,-0.09d0), (0.15d0,-0.03d0),
175 + (5.0d0,6.0d0), (5.0d0,6.0d0), (5.0d0,6.0d0),
176 + (5.0d0,6.0d0), (5.0d0,6.0d0), (5.0d0,6.0d0),
177 + (0.03d0,0.03d0), (-0.18d0,0.03d0),
178 + (0.03d0,-0.09d0), (7.0d0,8.0d0), (7.0d0,8.0d0),
179 + (7.0d0,8.0d0), (7.0d0,8.0d0), (7.0d0,8.0d0),
180 + (0.09d0,0.03d0), (0.03d0,0.12d0),
181 + (0.12d0,0.03d0), (0.03d0,0.06d0), (2.0d0,3.0d0),
182 + (2.0d0,3.0d0), (2.0d0,3.0d0), (2.0d0,3.0d0)/
183 DATA ((ctrue6(i,j,2),i=1,8),j=1,5)/(0.1d0,0.1d0),
184 + (4.0d0,5.0d0), (4.0d0,5.0d0), (4.0d0,5.0d0),
185 + (4.0d0,5.0d0), (4.0d0,5.0d0), (4.0d0,5.0d0),
186 + (4.0d0,5.0d0), (0.09d0,-0.12d0), (6.0d0,7.0d0),
187 + (6.0d0,7.0d0), (6.0d0,7.0d0), (6.0d0,7.0d0),
188 + (6.0d0,7.0d0), (6.0d0,7.0d0), (6.0d0,7.0d0),
189 + (0.03d0,-0.09d0), (8.0d0,9.0d0),
190 + (0.15d0,-0.03d0), (2.0d0,5.0d0), (2.0d0,5.0d0),
191 + (2.0d0,5.0d0), (2.0d0,5.0d0), (2.0d0,5.0d0),
192 + (0.03d0,0.03d0), (3.0d0,6.0d0),
193 + (-0.18d0,0.03d0), (4.0d0,7.0d0),
194 + (0.03d0,-0.09d0), (7.0d0,2.0d0), (7.0d0,2.0d0),
195 + (7.0d0,2.0d0), (0.09d0,0.03d0), (5.0d0,8.0d0),
196 + (0.03d0,0.12d0), (6.0d0,9.0d0), (0.12d0,0.03d0),
197 + (8.0d0,3.0d0), (0.03d0,0.06d0), (9.0d0,4.0d0)/
198 DATA itrue3/0, 1, 2, 2, 2/
199* .. Executable Statements ..
200 DO 60 incx = 1, 2
201 DO 40 np1 = 1, 5
202 n = np1 - 1
203 len = 2*max(n,1)
204* .. Set vector arguments ..
205 DO 20 i = 1, len
206 cx(i) = cv(i,np1,incx)
207 20 CONTINUE
208 IF (icase.EQ.6) THEN
209* .. DZNRM2TEST ..
210 CALL stest1(dznrm2test(n,cx,incx),strue2(np1),
211 + strue2(np1),sfac)
212 ELSE IF (icase.EQ.7) THEN
213* .. DZASUMTEST ..
214 CALL stest1(dzasumtest(n,cx,incx),strue4(np1),
215 + strue4(np1),sfac)
216 ELSE IF (icase.EQ.8) THEN
217* .. ZSCALTEST ..
218 CALL zscaltest(n,ca,cx,incx)
219 CALL ctest(len,cx,ctrue5(1,np1,incx),ctrue5(1,np1,incx),
220 + sfac)
221 ELSE IF (icase.EQ.9) THEN
222* .. ZDSCALTEST ..
223 CALL zdscaltest(n,sa,cx,incx)
224 CALL ctest(len,cx,ctrue6(1,np1,incx),ctrue6(1,np1,incx),
225 + sfac)
226 ELSE IF (icase.EQ.10) THEN
227* .. IZAMAXTEST ..
228 CALL itest1(izamaxtest(n,cx,incx),itrue3(np1))
229 ELSE
230 WRITE (nout,*) ' Shouldn''t be here in CHECK1'
231 stop
232 END IF
233*
234 40 CONTINUE
235 60 CONTINUE
236*
237 incx = 1
238 IF (icase.EQ.8) THEN
239* ZSCALTEST
240* Add a test for alpha equal to zero.
241 ca = (0.0d0,0.0d0)
242 DO 80 i = 1, 5
243 mwpct(i) = (0.0d0,0.0d0)
244 mwpcs(i) = (1.0d0,1.0d0)
245 80 CONTINUE
246 CALL zscaltest(5,ca,cx,incx)
247 CALL ctest(5,cx,mwpct,mwpcs,sfac)
248 ELSE IF (icase.EQ.9) THEN
249* ZDSCALTEST
250* Add a test for alpha equal to zero.
251 sa = 0.0d0
252 DO 100 i = 1, 5
253 mwpct(i) = (0.0d0,0.0d0)
254 mwpcs(i) = (1.0d0,1.0d0)
255 100 CONTINUE
256 CALL zdscaltest(5,sa,cx,incx)
257 CALL ctest(5,cx,mwpct,mwpcs,sfac)
258* Add a test for alpha equal to one.
259 sa = 1.0d0
260 DO 120 i = 1, 5
261 mwpct(i) = cx(i)
262 mwpcs(i) = cx(i)
263 120 CONTINUE
264 CALL zdscaltest(5,sa,cx,incx)
265 CALL ctest(5,cx,mwpct,mwpcs,sfac)
266* Add a test for alpha equal to minus one.
267 sa = -1.0d0
268 DO 140 i = 1, 5
269 mwpct(i) = -cx(i)
270 mwpcs(i) = -cx(i)
271 140 CONTINUE
272 CALL zdscaltest(5,sa,cx,incx)
273 CALL ctest(5,cx,mwpct,mwpcs,sfac)
274 END IF
275 RETURN
ctest
subroutine ctest(len, ccomp, ctrue, csize, sfac)
Definition cblat1.f:714
stest1
subroutine stest1(scomp1, strue1, ssize, sfac)
Definition cblat1.f:673
itest1
subroutine itest1(icomp, itrue)
Definition cblat1.f:748
Here is the call graph for this function: