LAPACK  3.8.0
LAPACK: Linear Algebra PACKage

◆ check1()

subroutine check1 ( double precision  SFAC)

Definition at line 144 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
subroutine itest1(ICOMP, ITRUE)
Definition: cblat1.f:686
subroutine stest1(SCOMP1, STRUE1, SSIZE, SFAC)
Definition: cblat1.f:620
subroutine stest(LEN, SCOMP, STRUE, SSIZE, SFAC)
Definition: cblat1.f:564
Here is the call graph for this function: