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

◆ check2()

subroutine check2 ( real  sfac)

Definition at line 237 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
stest
subroutine stest(len, scomp, strue, ssize, sfac)
Definition cblat1.f:614
stest1
subroutine stest1(scomp1, strue1, ssize, sfac)
Definition cblat1.f:673
Here is the call graph for this function: