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

◆ check2()

subroutine check2 ( real  sfac)

Definition at line 277 of file c_cblat1.f.

278* .. Parameters ..
279 INTEGER NOUT
280 parameter(nout=6)
281* .. Scalar Arguments ..
282 REAL SFAC
283* .. Scalars in Common ..
284 INTEGER ICASE, INCX, INCY, MODE, N
285 LOGICAL PASS
286* .. Local Scalars ..
287 COMPLEX CA,CTEMP
288 INTEGER I, J, KI, KN, KSIZE, LENX, LENY, MX, MY
289* .. Local Arrays ..
290 COMPLEX 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 cdotctest, cdotutest
296* .. External Subroutines ..
297 EXTERNAL caxpytest, ccopytest, cswaptest, 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.4e0,-0.7e0)/
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.7e0,-0.8e0), (-0.4e0,-0.7e0),
309 + (-0.1e0,-0.9e0), (0.2e0,-0.8e0),
310 + (-0.9e0,-0.4e0), (0.1e0,0.4e0), (-0.6e0,0.6e0)/
311 DATA cy1/(0.6e0,-0.6e0), (-0.9e0,0.5e0),
312 + (0.7e0,-0.6e0), (0.1e0,-0.5e0), (-0.1e0,-0.2e0),
313 + (-0.5e0,-0.3e0), (0.8e0,-0.7e0)/
314 DATA ((ct8(i,j,1),i=1,7),j=1,4)/(0.6e0,-0.6e0),
315 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
316 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
317 + (0.32e0,-1.41e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
318 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
319 + (0.0e0,0.0e0), (0.32e0,-1.41e0),
320 + (-1.55e0,0.5e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
321 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
322 + (0.32e0,-1.41e0), (-1.55e0,0.5e0),
323 + (0.03e0,-0.89e0), (-0.38e0,-0.96e0),
324 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0)/
325 DATA ((ct8(i,j,2),i=1,7),j=1,4)/(0.6e0,-0.6e0),
326 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
327 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
328 + (0.32e0,-1.41e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
329 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
330 + (0.0e0,0.0e0), (-0.07e0,-0.89e0),
331 + (-0.9e0,0.5e0), (0.42e0,-1.41e0), (0.0e0,0.0e0),
332 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
333 + (0.78e0,0.06e0), (-0.9e0,0.5e0),
334 + (0.06e0,-0.13e0), (0.1e0,-0.5e0),
335 + (-0.77e0,-0.49e0), (-0.5e0,-0.3e0),
336 + (0.52e0,-1.51e0)/
337 DATA ((ct8(i,j,3),i=1,7),j=1,4)/(0.6e0,-0.6e0),
338 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
339 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
340 + (0.32e0,-1.41e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
341 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
342 + (0.0e0,0.0e0), (-0.07e0,-0.89e0),
343 + (-1.18e0,-0.31e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
344 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
345 + (0.78e0,0.06e0), (-1.54e0,0.97e0),
346 + (0.03e0,-0.89e0), (-0.18e0,-1.31e0),
347 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0)/
348 DATA ((ct8(i,j,4),i=1,7),j=1,4)/(0.6e0,-0.6e0),
349 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
350 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
351 + (0.32e0,-1.41e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
352 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
353 + (0.0e0,0.0e0), (0.32e0,-1.41e0), (-0.9e0,0.5e0),
354 + (0.05e0,-0.6e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
355 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.32e0,-1.41e0),
356 + (-0.9e0,0.5e0), (0.05e0,-0.6e0), (0.1e0,-0.5e0),
357 + (-0.77e0,-0.49e0), (-0.5e0,-0.3e0),
358 + (0.32e0,-1.16e0)/
359 DATA ct7/(0.0e0,0.0e0), (-0.06e0,-0.90e0),
360 + (0.65e0,-0.47e0), (-0.34e0,-1.22e0),
361 + (0.0e0,0.0e0), (-0.06e0,-0.90e0),
362 + (-0.59e0,-1.46e0), (-1.04e0,-0.04e0),
363 + (0.0e0,0.0e0), (-0.06e0,-0.90e0),
364 + (-0.83e0,0.59e0), (0.07e0,-0.37e0),
365 + (0.0e0,0.0e0), (-0.06e0,-0.90e0),
366 + (-0.76e0,-1.15e0), (-1.33e0,-1.82e0)/
367 DATA ct6/(0.0e0,0.0e0), (0.90e0,0.06e0),
368 + (0.91e0,-0.77e0), (1.80e0,-0.10e0),
369 + (0.0e0,0.0e0), (0.90e0,0.06e0), (1.45e0,0.74e0),
370 + (0.20e0,0.90e0), (0.0e0,0.0e0), (0.90e0,0.06e0),
371 + (-0.55e0,0.23e0), (0.83e0,-0.39e0),
372 + (0.0e0,0.0e0), (0.90e0,0.06e0), (1.04e0,0.79e0),
373 + (1.95e0,1.22e0)/
374 DATA ((ct10x(i,j,1),i=1,7),j=1,4)/(0.7e0,-0.8e0),
375 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
376 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
377 + (0.6e0,-0.6e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
378 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
379 + (0.0e0,0.0e0), (0.6e0,-0.6e0), (-0.9e0,0.5e0),
380 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
381 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.6e0,-0.6e0),
382 + (-0.9e0,0.5e0), (0.7e0,-0.6e0), (0.1e0,-0.5e0),
383 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0)/
384 DATA ((ct10x(i,j,2),i=1,7),j=1,4)/(0.7e0,-0.8e0),
385 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
386 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
387 + (0.6e0,-0.6e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
388 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
389 + (0.0e0,0.0e0), (0.7e0,-0.6e0), (-0.4e0,-0.7e0),
390 + (0.6e0,-0.6e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
391 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.8e0,-0.7e0),
392 + (-0.4e0,-0.7e0), (-0.1e0,-0.2e0),
393 + (0.2e0,-0.8e0), (0.7e0,-0.6e0), (0.1e0,0.4e0),
394 + (0.6e0,-0.6e0)/
395 DATA ((ct10x(i,j,3),i=1,7),j=1,4)/(0.7e0,-0.8e0),
396 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
397 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
398 + (0.6e0,-0.6e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
399 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
400 + (0.0e0,0.0e0), (-0.9e0,0.5e0), (-0.4e0,-0.7e0),
401 + (0.6e0,-0.6e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
402 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.1e0,-0.5e0),
403 + (-0.4e0,-0.7e0), (0.7e0,-0.6e0), (0.2e0,-0.8e0),
404 + (-0.9e0,0.5e0), (0.1e0,0.4e0), (0.6e0,-0.6e0)/
405 DATA ((ct10x(i,j,4),i=1,7),j=1,4)/(0.7e0,-0.8e0),
406 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
407 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
408 + (0.6e0,-0.6e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
409 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
410 + (0.0e0,0.0e0), (0.6e0,-0.6e0), (0.7e0,-0.6e0),
411 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
412 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.6e0,-0.6e0),
413 + (0.7e0,-0.6e0), (-0.1e0,-0.2e0), (0.8e0,-0.7e0),
414 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0)/
415 DATA ((ct10y(i,j,1),i=1,7),j=1,4)/(0.6e0,-0.6e0),
416 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
417 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
418 + (0.7e0,-0.8e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
419 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
420 + (0.0e0,0.0e0), (0.7e0,-0.8e0), (-0.4e0,-0.7e0),
421 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
422 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.7e0,-0.8e0),
423 + (-0.4e0,-0.7e0), (-0.1e0,-0.9e0),
424 + (0.2e0,-0.8e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
425 + (0.0e0,0.0e0)/
426 DATA ((ct10y(i,j,2),i=1,7),j=1,4)/(0.6e0,-0.6e0),
427 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
428 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
429 + (0.7e0,-0.8e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
430 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
431 + (0.0e0,0.0e0), (-0.1e0,-0.9e0), (-0.9e0,0.5e0),
432 + (0.7e0,-0.8e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
433 + (0.0e0,0.0e0), (0.0e0,0.0e0), (-0.6e0,0.6e0),
434 + (-0.9e0,0.5e0), (-0.9e0,-0.4e0), (0.1e0,-0.5e0),
435 + (-0.1e0,-0.9e0), (-0.5e0,-0.3e0),
436 + (0.7e0,-0.8e0)/
437 DATA ((ct10y(i,j,3),i=1,7),j=1,4)/(0.6e0,-0.6e0),
438 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
439 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
440 + (0.7e0,-0.8e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
441 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
442 + (0.0e0,0.0e0), (-0.1e0,-0.9e0), (0.7e0,-0.8e0),
443 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
444 + (0.0e0,0.0e0), (0.0e0,0.0e0), (-0.6e0,0.6e0),
445 + (-0.9e0,-0.4e0), (-0.1e0,-0.9e0),
446 + (0.7e0,-0.8e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
447 + (0.0e0,0.0e0)/
448 DATA ((ct10y(i,j,4),i=1,7),j=1,4)/(0.6e0,-0.6e0),
449 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
450 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
451 + (0.7e0,-0.8e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
452 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
453 + (0.0e0,0.0e0), (0.7e0,-0.8e0), (-0.9e0,0.5e0),
454 + (-0.4e0,-0.7e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
455 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.7e0,-0.8e0),
456 + (-0.9e0,0.5e0), (-0.4e0,-0.7e0), (0.1e0,-0.5e0),
457 + (-0.1e0,-0.9e0), (-0.5e0,-0.3e0),
458 + (0.2e0,-0.8e0)/
459 DATA csize1/(0.0e0,0.0e0), (0.9e0,0.9e0),
460 + (1.63e0,1.73e0), (2.90e0,2.78e0)/
461 DATA csize3/(0.0e0,0.0e0), (0.0e0,0.0e0),
462 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
463 + (0.0e0,0.0e0), (0.0e0,0.0e0), (1.17e0,1.17e0),
464 + (1.17e0,1.17e0), (1.17e0,1.17e0),
465 + (1.17e0,1.17e0), (1.17e0,1.17e0),
466 + (1.17e0,1.17e0), (1.17e0,1.17e0)/
467 DATA csize2/(0.0e0,0.0e0), (0.0e0,0.0e0),
468 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
469 + (0.0e0,0.0e0), (0.0e0,0.0e0), (1.54e0,1.54e0),
470 + (1.54e0,1.54e0), (1.54e0,1.54e0),
471 + (1.54e0,1.54e0), (1.54e0,1.54e0),
472 + (1.54e0,1.54e0), (1.54e0,1.54e0)/
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* .. CDOTCTEST ..
492 CALL cdotctest(n,cx,incx,cy,incy,ctemp)
493 cdot(1) = ctemp
494 CALL ctest(1,cdot,ct6(kn,ki),csize1(kn),sfac)
495 ELSE IF (icase.EQ.2) THEN
496* .. CDOTUTEST ..
497 CALL cdotutest(n,cx,incx,cy,incy,ctemp)
498 cdot(1) = ctemp
499 CALL ctest(1,cdot,ct7(kn,ki),csize1(kn),sfac)
500 ELSE IF (icase.EQ.3) THEN
501* .. CAXPYTEST ..
502 CALL caxpytest(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* .. CCOPYTEST ..
506 CALL ccopytest(n,cx,incx,cy,incy)
507 CALL ctest(leny,cy,ct10y(1,kn,ki),csize3,1.0e0)
508 ELSE IF (icase.EQ.5) THEN
509* .. CSWAPTEST ..
510 CALL cswaptest(n,cx,incx,cy,incy)
511 CALL ctest(lenx,cx,ct10x(1,kn,ki),csize3,1.0e0)
512 CALL ctest(leny,cy,ct10y(1,kn,ki),csize3,1.0e0)
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: