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

◆ check0()

subroutine check0 ( double precision  sfac)

Definition at line 82 of file c_dblat1.f.

83* .. Parameters ..
84 INTEGER NOUT
85 parameter(nout=6)
86* .. Scalar Arguments ..
87 DOUBLE PRECISION SFAC
88* .. Scalars in Common ..
89 INTEGER ICASE, INCX, INCY, MODE, N
90 LOGICAL PASS
91* .. Local Scalars ..
92 DOUBLE PRECISION SA, SB, SC, SS
93 INTEGER K
94* .. Local Arrays ..
95 DOUBLE PRECISION DA1(8), DATRUE(8), DB1(8), DBTRUE(8), DC1(8),
96 + DS1(8)
97* .. External Subroutines ..
98 EXTERNAL drotgtest, stest1
99* .. Common blocks ..
100 COMMON /combla/icase, n, incx, incy, mode, pass
101* .. Data statements ..
102 DATA da1/0.3d0, 0.4d0, -0.3d0, -0.4d0, -0.3d0, 0.0d0,
103 + 0.0d0, 1.0d0/
104 DATA db1/0.4d0, 0.3d0, 0.4d0, 0.3d0, -0.4d0, 0.0d0,
105 + 1.0d0, 0.0d0/
106 DATA dc1/0.6d0, 0.8d0, -0.6d0, 0.8d0, 0.6d0, 1.0d0,
107 + 0.0d0, 1.0d0/
108 DATA ds1/0.8d0, 0.6d0, 0.8d0, -0.6d0, 0.8d0, 0.0d0,
109 + 1.0d0, 0.0d0/
110 DATA datrue/0.5d0, 0.5d0, 0.5d0, -0.5d0, -0.5d0,
111 + 0.0d0, 1.0d0, 1.0d0/
112 DATA dbtrue/0.0d0, 0.6d0, 0.0d0, -0.6d0, 0.0d0,
113 + 0.0d0, 1.0d0, 0.0d0/
114* .. Executable Statements ..
115*
116* Compute true values which cannot be prestored
117* in decimal notation
118*
119 dbtrue(1) = 1.0d0/0.6d0
120 dbtrue(3) = -1.0d0/0.6d0
121 dbtrue(5) = 1.0d0/0.6d0
122*
123 DO 20 k = 1, 8
124* .. Set N=K for identification in output if any ..
125 n = k
126 IF (icase.EQ.3) THEN
127* .. DROTGTEST ..
128 IF (k.GT.8) GO TO 40
129 sa = da1(k)
130 sb = db1(k)
131 CALL drotgtest(sa,sb,sc,ss)
132 CALL stest1(sa,datrue(k),datrue(k),sfac)
133 CALL stest1(sb,dbtrue(k),dbtrue(k),sfac)
134 CALL stest1(sc,dc1(k),dc1(k),sfac)
135 CALL stest1(ss,ds1(k),ds1(k),sfac)
136 ELSE
137 WRITE (nout,*) ' Shouldn''t be here in CHECK0'
138 stop
139 END IF
140 20 CONTINUE
141 40 RETURN
subroutine stest1(scomp1, strue1, ssize, sfac)
Definition cblat1.f:673
Here is the call graph for this function: