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

◆ check1()

subroutine check1 ( double precision  sfac)

Definition at line 121 of file zblat1.f.

122* .. Parameters ..
123 INTEGER NOUT
124 DOUBLE PRECISION THRESH
125 parameter(nout=6, thresh=10.0d0)
126* .. Scalar Arguments ..
127 DOUBLE PRECISION SFAC
128* .. Scalars in Common ..
129 INTEGER ICASE, INCX, INCY, MODE, N
130 LOGICAL PASS
131* .. Local Scalars ..
132 COMPLEX*16 CA
133 DOUBLE PRECISION SA
134 INTEGER I, IX, J, LEN, NP1
135* .. Local Arrays ..
136 COMPLEX*16 CTRUE5(8,5,2), CTRUE6(8,5,2), CV(8,5,2), CVR(8),
137 + CX(8), CXR(15), MWPCS(5), MWPCT(5)
138 DOUBLE PRECISION STRUE2(5), STRUE4(5)
139 INTEGER ITRUE3(5), ITRUEC(5)
140* .. External Functions ..
141 DOUBLE PRECISION DZASUM, DZNRM2
142 INTEGER IZAMAX
143 EXTERNAL dzasum, dznrm2, izamax
144* .. External Subroutines ..
145 EXTERNAL zb1nrm2, zscal, zdscal, ctest, itest1, stest1
146* .. Intrinsic Functions ..
147 INTRINSIC max
148* .. Common blocks ..
149 COMMON /combla/icase, n, incx, incy, mode, pass
150* .. Data statements ..
151 DATA sa, ca/0.3d0, (0.4d0,-0.7d0)/
152 DATA ((cv(i,j,1),i=1,8),j=1,5)/(0.1d0,0.1d0),
153 + (1.0d0,2.0d0), (1.0d0,2.0d0), (1.0d0,2.0d0),
154 + (1.0d0,2.0d0), (1.0d0,2.0d0), (1.0d0,2.0d0),
155 + (1.0d0,2.0d0), (0.3d0,-0.4d0), (3.0d0,4.0d0),
156 + (3.0d0,4.0d0), (3.0d0,4.0d0), (3.0d0,4.0d0),
157 + (3.0d0,4.0d0), (3.0d0,4.0d0), (3.0d0,4.0d0),
158 + (0.1d0,-0.3d0), (0.5d0,-0.1d0), (5.0d0,6.0d0),
159 + (5.0d0,6.0d0), (5.0d0,6.0d0), (5.0d0,6.0d0),
160 + (5.0d0,6.0d0), (5.0d0,6.0d0), (0.1d0,0.1d0),
161 + (-0.6d0,0.1d0), (0.1d0,-0.3d0), (7.0d0,8.0d0),
162 + (7.0d0,8.0d0), (7.0d0,8.0d0), (7.0d0,8.0d0),
163 + (7.0d0,8.0d0), (0.3d0,0.1d0), (0.5d0,0.0d0),
164 + (0.0d0,0.5d0), (0.0d0,0.2d0), (2.0d0,3.0d0),
165 + (2.0d0,3.0d0), (2.0d0,3.0d0), (2.0d0,3.0d0)/
166 DATA ((cv(i,j,2),i=1,8),j=1,5)/(0.1d0,0.1d0),
167 + (4.0d0,5.0d0), (4.0d0,5.0d0), (4.0d0,5.0d0),
168 + (4.0d0,5.0d0), (4.0d0,5.0d0), (4.0d0,5.0d0),
169 + (4.0d0,5.0d0), (0.3d0,-0.4d0), (6.0d0,7.0d0),
170 + (6.0d0,7.0d0), (6.0d0,7.0d0), (6.0d0,7.0d0),
171 + (6.0d0,7.0d0), (6.0d0,7.0d0), (6.0d0,7.0d0),
172 + (0.1d0,-0.3d0), (8.0d0,9.0d0), (0.5d0,-0.1d0),
173 + (2.0d0,5.0d0), (2.0d0,5.0d0), (2.0d0,5.0d0),
174 + (2.0d0,5.0d0), (2.0d0,5.0d0), (0.1d0,0.1d0),
175 + (3.0d0,6.0d0), (-0.6d0,0.1d0), (4.0d0,7.0d0),
176 + (0.1d0,-0.3d0), (7.0d0,2.0d0), (7.0d0,2.0d0),
177 + (7.0d0,2.0d0), (0.3d0,0.1d0), (5.0d0,8.0d0),
178 + (0.5d0,0.0d0), (6.0d0,9.0d0), (0.0d0,0.5d0),
179 + (8.0d0,3.0d0), (0.0d0,0.2d0), (9.0d0,4.0d0)/
180 DATA cvr/(8.0d0,8.0d0), (-7.0d0,-7.0d0),
181 + (9.0d0,9.0d0), (5.0d0,5.0d0), (9.0d0,9.0d0),
182 + (8.0d0,8.0d0), (7.0d0,7.0d0), (7.0d0,7.0d0)/
183 DATA strue2/0.0d0, 0.5d0, 0.6d0, 0.7d0, 0.8d0/
184 DATA strue4/0.0d0, 0.7d0, 1.0d0, 1.3d0, 1.6d0/
185 DATA ((ctrue5(i,j,1),i=1,8),j=1,5)/(0.1d0,0.1d0),
186 + (1.0d0,2.0d0), (1.0d0,2.0d0), (1.0d0,2.0d0),
187 + (1.0d0,2.0d0), (1.0d0,2.0d0), (1.0d0,2.0d0),
188 + (1.0d0,2.0d0), (-0.16d0,-0.37d0), (3.0d0,4.0d0),
189 + (3.0d0,4.0d0), (3.0d0,4.0d0), (3.0d0,4.0d0),
190 + (3.0d0,4.0d0), (3.0d0,4.0d0), (3.0d0,4.0d0),
191 + (-0.17d0,-0.19d0), (0.13d0,-0.39d0),
192 + (5.0d0,6.0d0), (5.0d0,6.0d0), (5.0d0,6.0d0),
193 + (5.0d0,6.0d0), (5.0d0,6.0d0), (5.0d0,6.0d0),
194 + (0.11d0,-0.03d0), (-0.17d0,0.46d0),
195 + (-0.17d0,-0.19d0), (7.0d0,8.0d0), (7.0d0,8.0d0),
196 + (7.0d0,8.0d0), (7.0d0,8.0d0), (7.0d0,8.0d0),
197 + (0.19d0,-0.17d0), (0.20d0,-0.35d0),
198 + (0.35d0,0.20d0), (0.14d0,0.08d0),
199 + (2.0d0,3.0d0), (2.0d0,3.0d0), (2.0d0,3.0d0),
200 + (2.0d0,3.0d0)/
201 DATA ((ctrue5(i,j,2),i=1,8),j=1,5)/(0.1d0,0.1d0),
202 + (4.0d0,5.0d0), (4.0d0,5.0d0), (4.0d0,5.0d0),
203 + (4.0d0,5.0d0), (4.0d0,5.0d0), (4.0d0,5.0d0),
204 + (4.0d0,5.0d0), (-0.16d0,-0.37d0), (6.0d0,7.0d0),
205 + (6.0d0,7.0d0), (6.0d0,7.0d0), (6.0d0,7.0d0),
206 + (6.0d0,7.0d0), (6.0d0,7.0d0), (6.0d0,7.0d0),
207 + (-0.17d0,-0.19d0), (8.0d0,9.0d0),
208 + (0.13d0,-0.39d0), (2.0d0,5.0d0), (2.0d0,5.0d0),
209 + (2.0d0,5.0d0), (2.0d0,5.0d0), (2.0d0,5.0d0),
210 + (0.11d0,-0.03d0), (3.0d0,6.0d0),
211 + (-0.17d0,0.46d0), (4.0d0,7.0d0),
212 + (-0.17d0,-0.19d0), (7.0d0,2.0d0), (7.0d0,2.0d0),
213 + (7.0d0,2.0d0), (0.19d0,-0.17d0), (5.0d0,8.0d0),
214 + (0.20d0,-0.35d0), (6.0d0,9.0d0),
215 + (0.35d0,0.20d0), (8.0d0,3.0d0),
216 + (0.14d0,0.08d0), (9.0d0,4.0d0)/
217 DATA ((ctrue6(i,j,1),i=1,8),j=1,5)/(0.1d0,0.1d0),
218 + (1.0d0,2.0d0), (1.0d0,2.0d0), (1.0d0,2.0d0),
219 + (1.0d0,2.0d0), (1.0d0,2.0d0), (1.0d0,2.0d0),
220 + (1.0d0,2.0d0), (0.09d0,-0.12d0), (3.0d0,4.0d0),
221 + (3.0d0,4.0d0), (3.0d0,4.0d0), (3.0d0,4.0d0),
222 + (3.0d0,4.0d0), (3.0d0,4.0d0), (3.0d0,4.0d0),
223 + (0.03d0,-0.09d0), (0.15d0,-0.03d0),
224 + (5.0d0,6.0d0), (5.0d0,6.0d0), (5.0d0,6.0d0),
225 + (5.0d0,6.0d0), (5.0d0,6.0d0), (5.0d0,6.0d0),
226 + (0.03d0,0.03d0), (-0.18d0,0.03d0),
227 + (0.03d0,-0.09d0), (7.0d0,8.0d0), (7.0d0,8.0d0),
228 + (7.0d0,8.0d0), (7.0d0,8.0d0), (7.0d0,8.0d0),
229 + (0.09d0,0.03d0), (0.15d0,0.00d0),
230 + (0.00d0,0.15d0), (0.00d0,0.06d0), (2.0d0,3.0d0),
231 + (2.0d0,3.0d0), (2.0d0,3.0d0), (2.0d0,3.0d0)/
232 DATA ((ctrue6(i,j,2),i=1,8),j=1,5)/(0.1d0,0.1d0),
233 + (4.0d0,5.0d0), (4.0d0,5.0d0), (4.0d0,5.0d0),
234 + (4.0d0,5.0d0), (4.0d0,5.0d0), (4.0d0,5.0d0),
235 + (4.0d0,5.0d0), (0.09d0,-0.12d0), (6.0d0,7.0d0),
236 + (6.0d0,7.0d0), (6.0d0,7.0d0), (6.0d0,7.0d0),
237 + (6.0d0,7.0d0), (6.0d0,7.0d0), (6.0d0,7.0d0),
238 + (0.03d0,-0.09d0), (8.0d0,9.0d0),
239 + (0.15d0,-0.03d0), (2.0d0,5.0d0), (2.0d0,5.0d0),
240 + (2.0d0,5.0d0), (2.0d0,5.0d0), (2.0d0,5.0d0),
241 + (0.03d0,0.03d0), (3.0d0,6.0d0),
242 + (-0.18d0,0.03d0), (4.0d0,7.0d0),
243 + (0.03d0,-0.09d0), (7.0d0,2.0d0), (7.0d0,2.0d0),
244 + (7.0d0,2.0d0), (0.09d0,0.03d0), (5.0d0,8.0d0),
245 + (0.15d0,0.00d0), (6.0d0,9.0d0), (0.00d0,0.15d0),
246 + (8.0d0,3.0d0), (0.00d0,0.06d0), (9.0d0,4.0d0)/
247 DATA itrue3/0, 1, 2, 2, 2/
248 DATA itruec/0, 1, 1, 1, 1/
249* .. Executable Statements ..
250 DO 60 incx = 1, 2
251 DO 40 np1 = 1, 5
252 n = np1 - 1
253 len = 2*max(n,1)
254* .. Set vector arguments ..
255 DO 20 i = 1, len
256 cx(i) = cv(i,np1,incx)
257 20 CONTINUE
258 IF (icase.EQ.6) THEN
259* .. DZNRM2 ..
260* Test scaling when some entries are tiny or huge
261 CALL zb1nrm2(n,(incx-2)*2,thresh)
262 CALL zb1nrm2(n,incx,thresh)
263* Test with hardcoded mid range entries
264 CALL stest1(dznrm2(n,cx,incx),strue2(np1),strue2(np1),
265 + sfac)
266 ELSE IF (icase.EQ.7) THEN
267* .. DZASUM ..
268 CALL stest1(dzasum(n,cx,incx),strue4(np1),strue4(np1),
269 + sfac)
270 ELSE IF (icase.EQ.8) THEN
271* .. ZSCAL ..
272 CALL zscal(n,ca,cx,incx)
273 CALL ctest(len,cx,ctrue5(1,np1,incx),ctrue5(1,np1,incx),
274 + sfac)
275 ELSE IF (icase.EQ.9) THEN
276* .. ZDSCAL ..
277 CALL zdscal(n,sa,cx,incx)
278 CALL ctest(len,cx,ctrue6(1,np1,incx),ctrue6(1,np1,incx),
279 + sfac)
280 ELSE IF (icase.EQ.10) THEN
281* .. IZAMAX ..
282 CALL itest1(izamax(n,cx,incx),itrue3(np1))
283 DO 160 i = 1, len
284 cx(i) = (42.0d0,43.0d0)
285 160 CONTINUE
286 CALL itest1(izamax(n,cx,incx),itruec(np1))
287 ELSE
288 WRITE (nout,*) ' Shouldn''t be here in CHECK1'
289 stop
290 END IF
291*
292 40 CONTINUE
293 IF (icase.EQ.10) THEN
294 n = 8
295 ix = 1
296 DO 180 i = 1, n
297 cxr(ix) = cvr(i)
298 ix = ix + incx
299 180 CONTINUE
300 CALL itest1(izamax(n,cxr,incx),3)
301 END IF
302 60 CONTINUE
303*
304 incx = 1
305 IF (icase.EQ.8) THEN
306* ZSCAL
307* Add a test for alpha equal to zero.
308 ca = (0.0d0,0.0d0)
309 DO 80 i = 1, 5
310 mwpct(i) = (0.0d0,0.0d0)
311 mwpcs(i) = (1.0d0,1.0d0)
312 80 CONTINUE
313 CALL zscal(5,ca,cx,incx)
314 CALL ctest(5,cx,mwpct,mwpcs,sfac)
315 ELSE IF (icase.EQ.9) THEN
316* ZDSCAL
317* Add a test for alpha equal to zero.
318 sa = 0.0d0
319 DO 100 i = 1, 5
320 mwpct(i) = (0.0d0,0.0d0)
321 mwpcs(i) = (1.0d0,1.0d0)
322 100 CONTINUE
323 CALL zdscal(5,sa,cx,incx)
324 CALL ctest(5,cx,mwpct,mwpcs,sfac)
325* Add a test for alpha equal to one.
326 sa = 1.0d0
327 DO 120 i = 1, 5
328 mwpct(i) = cx(i)
329 mwpcs(i) = cx(i)
330 120 CONTINUE
331 CALL zdscal(5,sa,cx,incx)
332 CALL ctest(5,cx,mwpct,mwpcs,sfac)
333* Add a test for alpha equal to minus one.
334 sa = -1.0d0
335 DO 140 i = 1, 5
336 mwpct(i) = -cx(i)
337 mwpcs(i) = -cx(i)
338 140 CONTINUE
339 CALL zdscal(5,sa,cx,incx)
340 CALL ctest(5,cx,mwpct,mwpcs,sfac)
341 END IF
342 RETURN
343*
344* End of CHECK1
345*
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
dzasum
double precision function dzasum(n, zx, incx)
DZASUM
Definition dzasum.f:72
izamax
integer function izamax(n, zx, incx)
IZAMAX
Definition izamax.f:71
dznrm2
real(wp) function dznrm2(n, x, incx)
DZNRM2
Definition dznrm2.f90:90
zdscal
subroutine zdscal(n, da, zx, incx)
ZDSCAL
Definition zdscal.f:78
zscal
subroutine zscal(n, za, zx, incx)
ZSCAL
Definition zscal.f:78
zb1nrm2
subroutine zb1nrm2(n, incx, thresh)
Definition zblat1.f:791
Here is the call graph for this function: