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

◆ check2()

subroutine check2 ( double precision  sfac)

Definition at line 237 of file c_dblat1.f.

238* .. Parameters ..
239 INTEGER NOUT
240 parameter(nout=6)
241* .. Scalar Arguments ..
242 DOUBLE PRECISION SFAC
243* .. Scalars in Common ..
244 INTEGER ICASE, INCX, INCY, MODE, N
245 LOGICAL PASS
246* .. Local Scalars ..
247 DOUBLE PRECISION SA
248 INTEGER I, J, KI, KN, KSIZE, LENX, LENY, MX, MY
249* .. Local Arrays ..
250 DOUBLE PRECISION 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 EXTERNAL ddottest
257 DOUBLE PRECISION DDOTTEST
258* .. External Subroutines ..
259 EXTERNAL daxpytest, dcopytest, dswaptest, 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.3d0/
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.6d0, 0.1d0, -0.5d0, 0.8d0, 0.9d0, -0.3d0,
271 + -0.4d0/
272 DATA dy1/0.5d0, -0.9d0, 0.3d0, 0.7d0, -0.6d0, 0.2d0,
273 + 0.8d0/
274 DATA dt7/0.0d0, 0.30d0, 0.21d0, 0.62d0, 0.0d0,
275 + 0.30d0, -0.07d0, 0.85d0, 0.0d0, 0.30d0, -0.79d0,
276 + -0.74d0, 0.0d0, 0.30d0, 0.33d0, 1.27d0/
277 DATA dt8/0.5d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
278 + 0.0d0, 0.68d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
279 + 0.0d0, 0.0d0, 0.68d0, -0.87d0, 0.0d0, 0.0d0,
280 + 0.0d0, 0.0d0, 0.0d0, 0.68d0, -0.87d0, 0.15d0,
281 + 0.94d0, 0.0d0, 0.0d0, 0.0d0, 0.5d0, 0.0d0,
282 + 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.68d0,
283 + 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
284 + 0.35d0, -0.9d0, 0.48d0, 0.0d0, 0.0d0, 0.0d0,
285 + 0.0d0, 0.38d0, -0.9d0, 0.57d0, 0.7d0, -0.75d0,
286 + 0.2d0, 0.98d0, 0.5d0, 0.0d0, 0.0d0, 0.0d0,
287 + 0.0d0, 0.0d0, 0.0d0, 0.68d0, 0.0d0, 0.0d0,
288 + 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.35d0, -0.72d0,
289 + 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.38d0,
290 + -0.63d0, 0.15d0, 0.88d0, 0.0d0, 0.0d0, 0.0d0,
291 + 0.5d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
292 + 0.68d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
293 + 0.0d0, 0.68d0, -0.9d0, 0.33d0, 0.0d0, 0.0d0,
294 + 0.0d0, 0.0d0, 0.68d0, -0.9d0, 0.33d0, 0.7d0,
295 + -0.75d0, 0.2d0, 1.04d0/
296 DATA dt10x/0.6d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
297 + 0.0d0, 0.5d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
298 + 0.0d0, 0.5d0, -0.9d0, 0.0d0, 0.0d0, 0.0d0,
299 + 0.0d0, 0.0d0, 0.5d0, -0.9d0, 0.3d0, 0.7d0,
300 + 0.0d0, 0.0d0, 0.0d0, 0.6d0, 0.0d0, 0.0d0, 0.0d0,
301 + 0.0d0, 0.0d0, 0.0d0, 0.5d0, 0.0d0, 0.0d0, 0.0d0,
302 + 0.0d0, 0.0d0, 0.0d0, 0.3d0, 0.1d0, 0.5d0, 0.0d0,
303 + 0.0d0, 0.0d0, 0.0d0, 0.8d0, 0.1d0, -0.6d0,
304 + 0.8d0, 0.3d0, -0.3d0, 0.5d0, 0.6d0, 0.0d0,
305 + 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.5d0, 0.0d0,
306 + 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, -0.9d0,
307 + 0.1d0, 0.5d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.7d0,
308 + 0.1d0, 0.3d0, 0.8d0, -0.9d0, -0.3d0, 0.5d0,
309 + 0.6d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
310 + 0.5d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
311 + 0.5d0, 0.3d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
312 + 0.5d0, 0.3d0, -0.6d0, 0.8d0, 0.0d0, 0.0d0,
313 + 0.0d0/
314 DATA dt10y/0.5d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
315 + 0.0d0, 0.6d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
316 + 0.0d0, 0.6d0, 0.1d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
317 + 0.0d0, 0.6d0, 0.1d0, -0.5d0, 0.8d0, 0.0d0,
318 + 0.0d0, 0.0d0, 0.5d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
319 + 0.0d0, 0.0d0, 0.6d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
320 + 0.0d0, 0.0d0, -0.5d0, -0.9d0, 0.6d0, 0.0d0,
321 + 0.0d0, 0.0d0, 0.0d0, -0.4d0, -0.9d0, 0.9d0,
322 + 0.7d0, -0.5d0, 0.2d0, 0.6d0, 0.5d0, 0.0d0,
323 + 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.6d0, 0.0d0,
324 + 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, -0.5d0,
325 + 0.6d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
326 + -0.4d0, 0.9d0, -0.5d0, 0.6d0, 0.0d0, 0.0d0,
327 + 0.0d0, 0.5d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
328 + 0.0d0, 0.6d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
329 + 0.0d0, 0.6d0, -0.9d0, 0.1d0, 0.0d0, 0.0d0,
330 + 0.0d0, 0.0d0, 0.6d0, -0.9d0, 0.1d0, 0.7d0,
331 + -0.5d0, 0.2d0, 0.8d0/
332 DATA ssize1/0.0d0, 0.3d0, 1.6d0, 3.2d0/
333 DATA ssize2/0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
334 + 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
335 + 0.0d0, 1.17d0, 1.17d0, 1.17d0, 1.17d0, 1.17d0,
336 + 1.17d0, 1.17d0, 1.17d0, 1.17d0, 1.17d0, 1.17d0,
337 + 1.17d0, 1.17d0, 1.17d0/
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* .. DDOTTEST ..
359 CALL stest1(ddottest(n,sx,incx,sy,incy),dt7(kn,ki),
360 + ssize1(kn),sfac)
361 ELSE IF (icase.EQ.2) THEN
362* .. DAXPYTEST ..
363 CALL daxpytest(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* .. DCOPYTEST ..
370 DO 60 i = 1, 7
371 sty(i) = dt10y(i,kn,ki)
372 60 CONTINUE
373 CALL dcopytest(n,sx,incx,sy,incy)
374 CALL stest(leny,sy,sty,ssize2(1,1),1.0d0)
375 ELSE IF (icase.EQ.6) THEN
376* .. DSWAPTEST ..
377 CALL dswaptest(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.0d0)
383 CALL stest(leny,sy,sty,ssize2(1,1),1.0d0)
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: