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

◆ check1()

subroutine check1 ( double precision  sfac)

Definition at line 143 of file c_dblat1.f.

144* .. Parameters ..
145 INTEGER NOUT
146 parameter(nout=6)
147* .. Scalar Arguments ..
148 DOUBLE PRECISION SFAC
149* .. Scalars in Common ..
150 INTEGER ICASE, INCX, INCY, MODE, N
151 LOGICAL PASS
152* .. Local Scalars ..
153 INTEGER I, LEN, NP1
154* .. Local Arrays ..
155 DOUBLE PRECISION DTRUE1(5), DTRUE3(5), DTRUE5(8,5,2), DV(8,5,2),
156 + SA(10), STEMP(1), STRUE(8), SX(8)
157 INTEGER ITRUE2(5)
158* .. External Functions ..
159 DOUBLE PRECISION DASUMTEST, DNRM2TEST
160 INTEGER IDAMAXTEST
161 EXTERNAL dasumtest, dnrm2test, idamaxtest
162* .. External Subroutines ..
163 EXTERNAL itest1, dscaltest, stest, stest1
164* .. Intrinsic Functions ..
165 INTRINSIC max
166* .. Common blocks ..
167 COMMON /combla/icase, n, incx, incy, mode, pass
168* .. Data statements ..
169 DATA sa/0.3d0, -1.0d0, 0.0d0, 1.0d0, 0.3d0, 0.3d0,
170 + 0.3d0, 0.3d0, 0.3d0, 0.3d0/
171 DATA dv/0.1d0, 2.0d0, 2.0d0, 2.0d0, 2.0d0, 2.0d0,
172 + 2.0d0, 2.0d0, 0.3d0, 3.0d0, 3.0d0, 3.0d0, 3.0d0,
173 + 3.0d0, 3.0d0, 3.0d0, 0.3d0, -0.4d0, 4.0d0,
174 + 4.0d0, 4.0d0, 4.0d0, 4.0d0, 4.0d0, 0.2d0,
175 + -0.6d0, 0.3d0, 5.0d0, 5.0d0, 5.0d0, 5.0d0,
176 + 5.0d0, 0.1d0, -0.3d0, 0.5d0, -0.1d0, 6.0d0,
177 + 6.0d0, 6.0d0, 6.0d0, 0.1d0, 8.0d0, 8.0d0, 8.0d0,
178 + 8.0d0, 8.0d0, 8.0d0, 8.0d0, 0.3d0, 9.0d0, 9.0d0,
179 + 9.0d0, 9.0d0, 9.0d0, 9.0d0, 9.0d0, 0.3d0, 2.0d0,
180 + -0.4d0, 2.0d0, 2.0d0, 2.0d0, 2.0d0, 2.0d0,
181 + 0.2d0, 3.0d0, -0.6d0, 5.0d0, 0.3d0, 2.0d0,
182 + 2.0d0, 2.0d0, 0.1d0, 4.0d0, -0.3d0, 6.0d0,
183 + -0.5d0, 7.0d0, -0.1d0, 3.0d0/
184 DATA dtrue1/0.0d0, 0.3d0, 0.5d0, 0.7d0, 0.6d0/
185 DATA dtrue3/0.0d0, 0.3d0, 0.7d0, 1.1d0, 1.0d0/
186 DATA dtrue5/0.10d0, 2.0d0, 2.0d0, 2.0d0, 2.0d0,
187 + 2.0d0, 2.0d0, 2.0d0, -0.3d0, 3.0d0, 3.0d0,
188 + 3.0d0, 3.0d0, 3.0d0, 3.0d0, 3.0d0, 0.0d0, 0.0d0,
189 + 4.0d0, 4.0d0, 4.0d0, 4.0d0, 4.0d0, 4.0d0,
190 + 0.20d0, -0.60d0, 0.30d0, 5.0d0, 5.0d0, 5.0d0,
191 + 5.0d0, 5.0d0, 0.03d0, -0.09d0, 0.15d0, -0.03d0,
192 + 6.0d0, 6.0d0, 6.0d0, 6.0d0, 0.10d0, 8.0d0,
193 + 8.0d0, 8.0d0, 8.0d0, 8.0d0, 8.0d0, 8.0d0,
194 + 0.09d0, 9.0d0, 9.0d0, 9.0d0, 9.0d0, 9.0d0,
195 + 9.0d0, 9.0d0, 0.09d0, 2.0d0, -0.12d0, 2.0d0,
196 + 2.0d0, 2.0d0, 2.0d0, 2.0d0, 0.06d0, 3.0d0,
197 + -0.18d0, 5.0d0, 0.09d0, 2.0d0, 2.0d0, 2.0d0,
198 + 0.03d0, 4.0d0, -0.09d0, 6.0d0, -0.15d0, 7.0d0,
199 + -0.03d0, 3.0d0/
200 DATA itrue2/0, 1, 2, 2, 3/
201* .. Executable Statements ..
202 DO 80 incx = 1, 2
203 DO 60 np1 = 1, 5
204 n = np1 - 1
205 len = 2*max(n,1)
206* .. Set vector arguments ..
207 DO 20 i = 1, len
208 sx(i) = dv(i,np1,incx)
209 20 CONTINUE
210*
211 IF (icase.EQ.7) THEN
212* .. DNRM2TEST ..
213 stemp(1) = dtrue1(np1)
214 CALL stest1(dnrm2test(n,sx,incx),stemp(1),stemp,sfac)
215 ELSE IF (icase.EQ.8) THEN
216* .. DASUMTEST ..
217 stemp(1) = dtrue3(np1)
218 CALL stest1(dasumtest(n,sx,incx),stemp(1),stemp,sfac)
219 ELSE IF (icase.EQ.9) THEN
220* .. DSCALTEST ..
221 CALL dscaltest(n,sa((incx-1)*5+np1),sx,incx)
222 DO 40 i = 1, len
223 strue(i) = dtrue5(i,np1,incx)
224 40 CONTINUE
225 CALL stest(len,sx,strue,strue,sfac)
226 ELSE IF (icase.EQ.10) THEN
227* .. IDAMAXTEST ..
228 CALL itest1(idamaxtest(n,sx,incx),itrue2(np1))
229 ELSE
230 WRITE (nout,*) ' Shouldn''t be here in CHECK1'
231 stop
232 END IF
233 60 CONTINUE
234 80 CONTINUE
235 RETURN
stest
subroutine stest(len, scomp, strue, ssize, sfac)
Definition cblat1.f:614
stest1
subroutine stest1(scomp1, strue1, ssize, sfac)
Definition cblat1.f:673
itest1
subroutine itest1(icomp, itrue)
Definition cblat1.f:748
Here is the call graph for this function: