LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine check2 ( real  SFAC)

Definition at line 278 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:655

Here is the call graph for this function: