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

Definition at line 238 of file c_sblat1.f.

238 * .. Parameters ..
239  INTEGER nout
240  parameter (nout=6)
241 * .. Scalar Arguments ..
242  REAL sfac
243 * .. Scalars in Common ..
244  INTEGER icase, incx, incy, mode, n
245  LOGICAL pass
246 * .. Local Scalars ..
247  REAL sa
248  INTEGER i, j, ki, kn, ksize, lenx, leny, mx, my
249 * .. Local Arrays ..
250  REAL dt10x(7,4,4), dt10y(7,4,4), dt7(4,4),
251  + dt8(7,4,4), dx1(7),
252  + dy1(7), ssize1(4), ssize2(14,2), stx(7), sty(7),
253  + sx(7), sy(7)
254  INTEGER incxs(4), incys(4), lens(4,2), ns(4)
255 * .. External Functions ..
256  REAL sdottest
257  EXTERNAL sdottest
258 * .. External Subroutines ..
259  EXTERNAL saxpytest, scopytest, sswaptest, stest, stest1
260 * .. Intrinsic Functions ..
261  INTRINSIC abs, min
262 * .. Common blocks ..
263  COMMON /combla/icase, n, incx, incy, mode, pass
264 * .. Data statements ..
265  DATA sa/0.3e0/
266  DATA incxs/1, 2, -2, -1/
267  DATA incys/1, -2, 1, -2/
268  DATA lens/1, 1, 2, 4, 1, 1, 3, 7/
269  DATA ns/0, 1, 2, 4/
270  DATA dx1/0.6e0, 0.1e0, -0.5e0, 0.8e0, 0.9e0, -0.3e0,
271  + -0.4e0/
272  DATA dy1/0.5e0, -0.9e0, 0.3e0, 0.7e0, -0.6e0, 0.2e0,
273  + 0.8e0/
274  DATA dt7/0.0e0, 0.30e0, 0.21e0, 0.62e0, 0.0e0,
275  + 0.30e0, -0.07e0, 0.85e0, 0.0e0, 0.30e0, -0.79e0,
276  + -0.74e0, 0.0e0, 0.30e0, 0.33e0, 1.27e0/
277  DATA dt8/0.5e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
278  + 0.0e0, 0.68e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
279  + 0.0e0, 0.0e0, 0.68e0, -0.87e0, 0.0e0, 0.0e0,
280  + 0.0e0, 0.0e0, 0.0e0, 0.68e0, -0.87e0, 0.15e0,
281  + 0.94e0, 0.0e0, 0.0e0, 0.0e0, 0.5e0, 0.0e0,
282  + 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.68e0,
283  + 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
284  + 0.35e0, -0.9e0, 0.48e0, 0.0e0, 0.0e0, 0.0e0,
285  + 0.0e0, 0.38e0, -0.9e0, 0.57e0, 0.7e0, -0.75e0,
286  + 0.2e0, 0.98e0, 0.5e0, 0.0e0, 0.0e0, 0.0e0,
287  + 0.0e0, 0.0e0, 0.0e0, 0.68e0, 0.0e0, 0.0e0,
288  + 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.35e0, -0.72e0,
289  + 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.38e0,
290  + -0.63e0, 0.15e0, 0.88e0, 0.0e0, 0.0e0, 0.0e0,
291  + 0.5e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
292  + 0.68e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
293  + 0.0e0, 0.68e0, -0.9e0, 0.33e0, 0.0e0, 0.0e0,
294  + 0.0e0, 0.0e0, 0.68e0, -0.9e0, 0.33e0, 0.7e0,
295  + -0.75e0, 0.2e0, 1.04e0/
296  DATA dt10x/0.6e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
297  + 0.0e0, 0.5e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
298  + 0.0e0, 0.5e0, -0.9e0, 0.0e0, 0.0e0, 0.0e0,
299  + 0.0e0, 0.0e0, 0.5e0, -0.9e0, 0.3e0, 0.7e0,
300  + 0.0e0, 0.0e0, 0.0e0, 0.6e0, 0.0e0, 0.0e0, 0.0e0,
301  + 0.0e0, 0.0e0, 0.0e0, 0.5e0, 0.0e0, 0.0e0, 0.0e0,
302  + 0.0e0, 0.0e0, 0.0e0, 0.3e0, 0.1e0, 0.5e0, 0.0e0,
303  + 0.0e0, 0.0e0, 0.0e0, 0.8e0, 0.1e0, -0.6e0,
304  + 0.8e0, 0.3e0, -0.3e0, 0.5e0, 0.6e0, 0.0e0,
305  + 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.5e0, 0.0e0,
306  + 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, -0.9e0,
307  + 0.1e0, 0.5e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.7e0,
308  + 0.1e0, 0.3e0, 0.8e0, -0.9e0, -0.3e0, 0.5e0,
309  + 0.6e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
310  + 0.5e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
311  + 0.5e0, 0.3e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
312  + 0.5e0, 0.3e0, -0.6e0, 0.8e0, 0.0e0, 0.0e0,
313  + 0.0e0/
314  DATA dt10y/0.5e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
315  + 0.0e0, 0.6e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
316  + 0.0e0, 0.6e0, 0.1e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
317  + 0.0e0, 0.6e0, 0.1e0, -0.5e0, 0.8e0, 0.0e0,
318  + 0.0e0, 0.0e0, 0.5e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
319  + 0.0e0, 0.0e0, 0.6e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
320  + 0.0e0, 0.0e0, -0.5e0, -0.9e0, 0.6e0, 0.0e0,
321  + 0.0e0, 0.0e0, 0.0e0, -0.4e0, -0.9e0, 0.9e0,
322  + 0.7e0, -0.5e0, 0.2e0, 0.6e0, 0.5e0, 0.0e0,
323  + 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.6e0, 0.0e0,
324  + 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, -0.5e0,
325  + 0.6e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
326  + -0.4e0, 0.9e0, -0.5e0, 0.6e0, 0.0e0, 0.0e0,
327  + 0.0e0, 0.5e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
328  + 0.0e0, 0.6e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
329  + 0.0e0, 0.6e0, -0.9e0, 0.1e0, 0.0e0, 0.0e0,
330  + 0.0e0, 0.0e0, 0.6e0, -0.9e0, 0.1e0, 0.7e0,
331  + -0.5e0, 0.2e0, 0.8e0/
332  DATA ssize1/0.0e0, 0.3e0, 1.6e0, 3.2e0/
333  DATA ssize2/0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
334  + 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
335  + 0.0e0, 1.17e0, 1.17e0, 1.17e0, 1.17e0, 1.17e0,
336  + 1.17e0, 1.17e0, 1.17e0, 1.17e0, 1.17e0, 1.17e0,
337  + 1.17e0, 1.17e0, 1.17e0/
338 * .. Executable Statements ..
339 *
340  DO 120 ki = 1, 4
341  incx = incxs(ki)
342  incy = incys(ki)
343  mx = abs(incx)
344  my = abs(incy)
345 *
346  DO 100 kn = 1, 4
347  n = ns(kn)
348  ksize = min(2,kn)
349  lenx = lens(kn,mx)
350  leny = lens(kn,my)
351 * .. Initialize all argument arrays ..
352  DO 20 i = 1, 7
353  sx(i) = dx1(i)
354  sy(i) = dy1(i)
355  20 CONTINUE
356 *
357  IF (icase.EQ.1) THEN
358 * .. SDOTTEST ..
359  CALL stest1(sdottest(n,sx,incx,sy,incy),dt7(kn,ki),
360  + ssize1(kn),sfac)
361  ELSE IF (icase.EQ.2) THEN
362 * .. SAXPYTEST ..
363  CALL saxpytest(n,sa,sx,incx,sy,incy)
364  DO 40 j = 1, leny
365  sty(j) = dt8(j,kn,ki)
366  40 CONTINUE
367  CALL stest(leny,sy,sty,ssize2(1,ksize),sfac)
368  ELSE IF (icase.EQ.5) THEN
369 * .. SCOPYTEST ..
370  DO 60 i = 1, 7
371  sty(i) = dt10y(i,kn,ki)
372  60 CONTINUE
373  CALL scopytest(n,sx,incx,sy,incy)
374  CALL stest(leny,sy,sty,ssize2(1,1),1.0e0)
375  ELSE IF (icase.EQ.6) THEN
376 * .. SSWAPTEST ..
377  CALL sswaptest(n,sx,incx,sy,incy)
378  DO 80 i = 1, 7
379  stx(i) = dt10x(i,kn,ki)
380  sty(i) = dt10y(i,kn,ki)
381  80 CONTINUE
382  CALL stest(lenx,sx,stx,ssize2(1,1),1.0e0)
383  CALL stest(leny,sy,sty,ssize2(1,1),1.0e0)
384  ELSE
385  WRITE (nout,*) ' Shouldn''t be here in CHECK2'
386  stop
387  END IF
388  100 CONTINUE
389  120 CONTINUE
390  RETURN
stest1
subroutine stest1(SCOMP1, STRUE1, SSIZE, SFAC)
Definition: cblat1.f:620
stest
subroutine stest(LEN, SCOMP, STRUE, SSIZE, SFAC)
Definition: cblat1.f:564

Here is the call graph for this function: