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

◆ check2()

subroutine check2 ( double precision  sfac)

Definition at line 277 of file c_zblat1.f.

278* .. Parameters ..
279 INTEGER NOUT
280 parameter(nout=6)
281* .. Scalar Arguments ..
282 DOUBLE PRECISION SFAC
283* .. Scalars in Common ..
284 INTEGER ICASE, INCX, INCY, MODE, N
285 LOGICAL PASS
286* .. Local Scalars ..
287 COMPLEX*16 CA,ZTEMP
288 INTEGER I, J, KI, KN, KSIZE, LENX, LENY, MX, MY
289* .. Local Arrays ..
290 COMPLEX*16 CDOT(1), CSIZE1(4), CSIZE2(7,2), CSIZE3(14),
291 + CT10X(7,4,4), CT10Y(7,4,4), CT6(4,4), CT7(4,4),
292 + CT8(7,4,4), CX(7), CX1(7), CY(7), CY1(7)
293 INTEGER INCXS(4), INCYS(4), LENS(4,2), NS(4)
294* .. External Functions ..
295 EXTERNAL zdotctest, zdotutest
296* .. External Subroutines ..
297 EXTERNAL zaxpytest, zcopytest, zswaptest, ctest
298* .. Intrinsic Functions ..
299 INTRINSIC abs, min
300* .. Common blocks ..
301 COMMON /combla/icase, n, incx, incy, mode, pass
302* .. Data statements ..
303 DATA ca/(0.4d0,-0.7d0)/
304 DATA incxs/1, 2, -2, -1/
305 DATA incys/1, -2, 1, -2/
306 DATA lens/1, 1, 2, 4, 1, 1, 3, 7/
307 DATA ns/0, 1, 2, 4/
308 DATA cx1/(0.7d0,-0.8d0), (-0.4d0,-0.7d0),
309 + (-0.1d0,-0.9d0), (0.2d0,-0.8d0),
310 + (-0.9d0,-0.4d0), (0.1d0,0.4d0), (-0.6d0,0.6d0)/
311 DATA cy1/(0.6d0,-0.6d0), (-0.9d0,0.5d0),
312 + (0.7d0,-0.6d0), (0.1d0,-0.5d0), (-0.1d0,-0.2d0),
313 + (-0.5d0,-0.3d0), (0.8d0,-0.7d0)/
314 DATA ((ct8(i,j,1),i=1,7),j=1,4)/(0.6d0,-0.6d0),
315 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
316 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
317 + (0.32d0,-1.41d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
318 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
319 + (0.0d0,0.0d0), (0.32d0,-1.41d0),
320 + (-1.55d0,0.5d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
321 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
322 + (0.32d0,-1.41d0), (-1.55d0,0.5d0),
323 + (0.03d0,-0.89d0), (-0.38d0,-0.96d0),
324 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0)/
325 DATA ((ct8(i,j,2),i=1,7),j=1,4)/(0.6d0,-0.6d0),
326 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
327 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
328 + (0.32d0,-1.41d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
329 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
330 + (0.0d0,0.0d0), (-0.07d0,-0.89d0),
331 + (-0.9d0,0.5d0), (0.42d0,-1.41d0), (0.0d0,0.0d0),
332 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
333 + (0.78d0,0.06d0), (-0.9d0,0.5d0),
334 + (0.06d0,-0.13d0), (0.1d0,-0.5d0),
335 + (-0.77d0,-0.49d0), (-0.5d0,-0.3d0),
336 + (0.52d0,-1.51d0)/
337 DATA ((ct8(i,j,3),i=1,7),j=1,4)/(0.6d0,-0.6d0),
338 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
339 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
340 + (0.32d0,-1.41d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
341 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
342 + (0.0d0,0.0d0), (-0.07d0,-0.89d0),
343 + (-1.18d0,-0.31d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
344 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
345 + (0.78d0,0.06d0), (-1.54d0,0.97d0),
346 + (0.03d0,-0.89d0), (-0.18d0,-1.31d0),
347 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0)/
348 DATA ((ct8(i,j,4),i=1,7),j=1,4)/(0.6d0,-0.6d0),
349 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
350 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
351 + (0.32d0,-1.41d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
352 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
353 + (0.0d0,0.0d0), (0.32d0,-1.41d0), (-0.9d0,0.5d0),
354 + (0.05d0,-0.6d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
355 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.32d0,-1.41d0),
356 + (-0.9d0,0.5d0), (0.05d0,-0.6d0), (0.1d0,-0.5d0),
357 + (-0.77d0,-0.49d0), (-0.5d0,-0.3d0),
358 + (0.32d0,-1.16d0)/
359 DATA ct7/(0.0d0,0.0d0), (-0.06d0,-0.90d0),
360 + (0.65d0,-0.47d0), (-0.34d0,-1.22d0),
361 + (0.0d0,0.0d0), (-0.06d0,-0.90d0),
362 + (-0.59d0,-1.46d0), (-1.04d0,-0.04d0),
363 + (0.0d0,0.0d0), (-0.06d0,-0.90d0),
364 + (-0.83d0,0.59d0), (0.07d0,-0.37d0),
365 + (0.0d0,0.0d0), (-0.06d0,-0.90d0),
366 + (-0.76d0,-1.15d0), (-1.33d0,-1.82d0)/
367 DATA ct6/(0.0d0,0.0d0), (0.90d0,0.06d0),
368 + (0.91d0,-0.77d0), (1.80d0,-0.10d0),
369 + (0.0d0,0.0d0), (0.90d0,0.06d0), (1.45d0,0.74d0),
370 + (0.20d0,0.90d0), (0.0d0,0.0d0), (0.90d0,0.06d0),
371 + (-0.55d0,0.23d0), (0.83d0,-0.39d0),
372 + (0.0d0,0.0d0), (0.90d0,0.06d0), (1.04d0,0.79d0),
373 + (1.95d0,1.22d0)/
374 DATA ((ct10x(i,j,1),i=1,7),j=1,4)/(0.7d0,-0.8d0),
375 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
376 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
377 + (0.6d0,-0.6d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
378 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
379 + (0.0d0,0.0d0), (0.6d0,-0.6d0), (-0.9d0,0.5d0),
380 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
381 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.6d0,-0.6d0),
382 + (-0.9d0,0.5d0), (0.7d0,-0.6d0), (0.1d0,-0.5d0),
383 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0)/
384 DATA ((ct10x(i,j,2),i=1,7),j=1,4)/(0.7d0,-0.8d0),
385 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
386 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
387 + (0.6d0,-0.6d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
388 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
389 + (0.0d0,0.0d0), (0.7d0,-0.6d0), (-0.4d0,-0.7d0),
390 + (0.6d0,-0.6d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
391 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.8d0,-0.7d0),
392 + (-0.4d0,-0.7d0), (-0.1d0,-0.2d0),
393 + (0.2d0,-0.8d0), (0.7d0,-0.6d0), (0.1d0,0.4d0),
394 + (0.6d0,-0.6d0)/
395 DATA ((ct10x(i,j,3),i=1,7),j=1,4)/(0.7d0,-0.8d0),
396 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
397 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
398 + (0.6d0,-0.6d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
399 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
400 + (0.0d0,0.0d0), (-0.9d0,0.5d0), (-0.4d0,-0.7d0),
401 + (0.6d0,-0.6d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
402 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.1d0,-0.5d0),
403 + (-0.4d0,-0.7d0), (0.7d0,-0.6d0), (0.2d0,-0.8d0),
404 + (-0.9d0,0.5d0), (0.1d0,0.4d0), (0.6d0,-0.6d0)/
405 DATA ((ct10x(i,j,4),i=1,7),j=1,4)/(0.7d0,-0.8d0),
406 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
407 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
408 + (0.6d0,-0.6d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
409 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
410 + (0.0d0,0.0d0), (0.6d0,-0.6d0), (0.7d0,-0.6d0),
411 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
412 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.6d0,-0.6d0),
413 + (0.7d0,-0.6d0), (-0.1d0,-0.2d0), (0.8d0,-0.7d0),
414 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0)/
415 DATA ((ct10y(i,j,1),i=1,7),j=1,4)/(0.6d0,-0.6d0),
416 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
417 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
418 + (0.7d0,-0.8d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
419 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
420 + (0.0d0,0.0d0), (0.7d0,-0.8d0), (-0.4d0,-0.7d0),
421 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
422 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.7d0,-0.8d0),
423 + (-0.4d0,-0.7d0), (-0.1d0,-0.9d0),
424 + (0.2d0,-0.8d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
425 + (0.0d0,0.0d0)/
426 DATA ((ct10y(i,j,2),i=1,7),j=1,4)/(0.6d0,-0.6d0),
427 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
428 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
429 + (0.7d0,-0.8d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
430 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
431 + (0.0d0,0.0d0), (-0.1d0,-0.9d0), (-0.9d0,0.5d0),
432 + (0.7d0,-0.8d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
433 + (0.0d0,0.0d0), (0.0d0,0.0d0), (-0.6d0,0.6d0),
434 + (-0.9d0,0.5d0), (-0.9d0,-0.4d0), (0.1d0,-0.5d0),
435 + (-0.1d0,-0.9d0), (-0.5d0,-0.3d0),
436 + (0.7d0,-0.8d0)/
437 DATA ((ct10y(i,j,3),i=1,7),j=1,4)/(0.6d0,-0.6d0),
438 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
439 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
440 + (0.7d0,-0.8d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
441 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
442 + (0.0d0,0.0d0), (-0.1d0,-0.9d0), (0.7d0,-0.8d0),
443 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
444 + (0.0d0,0.0d0), (0.0d0,0.0d0), (-0.6d0,0.6d0),
445 + (-0.9d0,-0.4d0), (-0.1d0,-0.9d0),
446 + (0.7d0,-0.8d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
447 + (0.0d0,0.0d0)/
448 DATA ((ct10y(i,j,4),i=1,7),j=1,4)/(0.6d0,-0.6d0),
449 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
450 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
451 + (0.7d0,-0.8d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
452 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
453 + (0.0d0,0.0d0), (0.7d0,-0.8d0), (-0.9d0,0.5d0),
454 + (-0.4d0,-0.7d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
455 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.7d0,-0.8d0),
456 + (-0.9d0,0.5d0), (-0.4d0,-0.7d0), (0.1d0,-0.5d0),
457 + (-0.1d0,-0.9d0), (-0.5d0,-0.3d0),
458 + (0.2d0,-0.8d0)/
459 DATA csize1/(0.0d0,0.0d0), (0.9d0,0.9d0),
460 + (1.63d0,1.73d0), (2.90d0,2.78d0)/
461 DATA csize3/(0.0d0,0.0d0), (0.0d0,0.0d0),
462 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
463 + (0.0d0,0.0d0), (0.0d0,0.0d0), (1.17d0,1.17d0),
464 + (1.17d0,1.17d0), (1.17d0,1.17d0),
465 + (1.17d0,1.17d0), (1.17d0,1.17d0),
466 + (1.17d0,1.17d0), (1.17d0,1.17d0)/
467 DATA csize2/(0.0d0,0.0d0), (0.0d0,0.0d0),
468 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
469 + (0.0d0,0.0d0), (0.0d0,0.0d0), (1.54d0,1.54d0),
470 + (1.54d0,1.54d0), (1.54d0,1.54d0),
471 + (1.54d0,1.54d0), (1.54d0,1.54d0),
472 + (1.54d0,1.54d0), (1.54d0,1.54d0)/
473* .. Executable Statements ..
474 DO 60 ki = 1, 4
475 incx = incxs(ki)
476 incy = incys(ki)
477 mx = abs(incx)
478 my = abs(incy)
479*
480 DO 40 kn = 1, 4
481 n = ns(kn)
482 ksize = min(2,kn)
483 lenx = lens(kn,mx)
484 leny = lens(kn,my)
485* .. initialize all argument arrays ..
486 DO 20 i = 1, 7
487 cx(i) = cx1(i)
488 cy(i) = cy1(i)
489 20 CONTINUE
490 IF (icase.EQ.1) THEN
491* .. ZDOTCTEST ..
492 CALL zdotctest(n,cx,incx,cy,incy,ztemp)
493 cdot(1) = ztemp
494 CALL ctest(1,cdot,ct6(kn,ki),csize1(kn),sfac)
495 ELSE IF (icase.EQ.2) THEN
496* .. ZDOTUTEST ..
497 CALL zdotutest(n,cx,incx,cy,incy,ztemp)
498 cdot(1) = ztemp
499 CALL ctest(1,cdot,ct7(kn,ki),csize1(kn),sfac)
500 ELSE IF (icase.EQ.3) THEN
501* .. ZAXPYTEST ..
502 CALL zaxpytest(n,ca,cx,incx,cy,incy)
503 CALL ctest(leny,cy,ct8(1,kn,ki),csize2(1,ksize),sfac)
504 ELSE IF (icase.EQ.4) THEN
505* .. ZCOPYTEST ..
506 CALL zcopytest(n,cx,incx,cy,incy)
507 CALL ctest(leny,cy,ct10y(1,kn,ki),csize3,1.0d0)
508 ELSE IF (icase.EQ.5) THEN
509* .. ZSWAPTEST ..
510 CALL zswaptest(n,cx,incx,cy,incy)
511 CALL ctest(lenx,cx,ct10x(1,kn,ki),csize3,1.0d0)
512 CALL ctest(leny,cy,ct10y(1,kn,ki),csize3,1.0d0)
513 ELSE
514 WRITE (nout,*) ' Shouldn''t be here in CHECK2'
515 stop
516 END IF
517*
518 40 CONTINUE
519 60 CONTINUE
520 RETURN
ctest
subroutine ctest(len, ccomp, ctrue, csize, sfac)
Definition cblat1.f:714
Here is the call graph for this function: