LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ check1()

subroutine check1 ( double precision  SFAC)

Definition at line 121 of file zblat1.f.

122 * .. Parameters ..
123  INTEGER NOUT
124  parameter(nout=6)
125 * .. Scalar Arguments ..
126  DOUBLE PRECISION SFAC
127 * .. Scalars in Common ..
128  INTEGER ICASE, INCX, INCY, MODE, N
129  LOGICAL PASS
130 * .. Local Scalars ..
131  COMPLEX*16 CA
132  DOUBLE PRECISION SA
133  INTEGER I, IX, J, LEN, NP1
134 * .. Local Arrays ..
135  COMPLEX*16 CTRUE5(8,5,2), CTRUE6(8,5,2), CV(8,5,2), CVR(8),
136  + CX(8), CXR(15), MWPCS(5), MWPCT(5)
137  DOUBLE PRECISION STRUE2(5), STRUE4(5)
138  INTEGER ITRUE3(5), ITRUEC(5)
139 * .. External Functions ..
140  DOUBLE PRECISION DZASUM, DZNRM2
141  INTEGER IZAMAX
142  EXTERNAL dzasum, dznrm2, izamax
143 * .. External Subroutines ..
144  EXTERNAL zscal, zdscal, ctest, itest1, stest1
145 * .. Intrinsic Functions ..
146  INTRINSIC max
147 * .. Common blocks ..
148  COMMON /combla/icase, n, incx, incy, mode, pass
149 * .. Data statements ..
150  DATA sa, ca/0.3d0, (0.4d0,-0.7d0)/
151  DATA ((cv(i,j,1),i=1,8),j=1,5)/(0.1d0,0.1d0),
152  + (1.0d0,2.0d0), (1.0d0,2.0d0), (1.0d0,2.0d0),
153  + (1.0d0,2.0d0), (1.0d0,2.0d0), (1.0d0,2.0d0),
154  + (1.0d0,2.0d0), (0.3d0,-0.4d0), (3.0d0,4.0d0),
155  + (3.0d0,4.0d0), (3.0d0,4.0d0), (3.0d0,4.0d0),
156  + (3.0d0,4.0d0), (3.0d0,4.0d0), (3.0d0,4.0d0),
157  + (0.1d0,-0.3d0), (0.5d0,-0.1d0), (5.0d0,6.0d0),
158  + (5.0d0,6.0d0), (5.0d0,6.0d0), (5.0d0,6.0d0),
159  + (5.0d0,6.0d0), (5.0d0,6.0d0), (0.1d0,0.1d0),
160  + (-0.6d0,0.1d0), (0.1d0,-0.3d0), (7.0d0,8.0d0),
161  + (7.0d0,8.0d0), (7.0d0,8.0d0), (7.0d0,8.0d0),
162  + (7.0d0,8.0d0), (0.3d0,0.1d0), (0.5d0,0.0d0),
163  + (0.0d0,0.5d0), (0.0d0,0.2d0), (2.0d0,3.0d0),
164  + (2.0d0,3.0d0), (2.0d0,3.0d0), (2.0d0,3.0d0)/
165  DATA ((cv(i,j,2),i=1,8),j=1,5)/(0.1d0,0.1d0),
166  + (4.0d0,5.0d0), (4.0d0,5.0d0), (4.0d0,5.0d0),
167  + (4.0d0,5.0d0), (4.0d0,5.0d0), (4.0d0,5.0d0),
168  + (4.0d0,5.0d0), (0.3d0,-0.4d0), (6.0d0,7.0d0),
169  + (6.0d0,7.0d0), (6.0d0,7.0d0), (6.0d0,7.0d0),
170  + (6.0d0,7.0d0), (6.0d0,7.0d0), (6.0d0,7.0d0),
171  + (0.1d0,-0.3d0), (8.0d0,9.0d0), (0.5d0,-0.1d0),
172  + (2.0d0,5.0d0), (2.0d0,5.0d0), (2.0d0,5.0d0),
173  + (2.0d0,5.0d0), (2.0d0,5.0d0), (0.1d0,0.1d0),
174  + (3.0d0,6.0d0), (-0.6d0,0.1d0), (4.0d0,7.0d0),
175  + (0.1d0,-0.3d0), (7.0d0,2.0d0), (7.0d0,2.0d0),
176  + (7.0d0,2.0d0), (0.3d0,0.1d0), (5.0d0,8.0d0),
177  + (0.5d0,0.0d0), (6.0d0,9.0d0), (0.0d0,0.5d0),
178  + (8.0d0,3.0d0), (0.0d0,0.2d0), (9.0d0,4.0d0)/
179  DATA cvr/(8.0d0,8.0d0), (-7.0d0,-7.0d0),
180  + (9.0d0,9.0d0), (5.0d0,5.0d0), (9.0d0,9.0d0),
181  + (8.0d0,8.0d0), (7.0d0,7.0d0), (7.0d0,7.0d0)/
182  DATA strue2/0.0d0, 0.5d0, 0.6d0, 0.7d0, 0.8d0/
183  DATA strue4/0.0d0, 0.7d0, 1.0d0, 1.3d0, 1.6d0/
184  DATA ((ctrue5(i,j,1),i=1,8),j=1,5)/(0.1d0,0.1d0),
185  + (1.0d0,2.0d0), (1.0d0,2.0d0), (1.0d0,2.0d0),
186  + (1.0d0,2.0d0), (1.0d0,2.0d0), (1.0d0,2.0d0),
187  + (1.0d0,2.0d0), (-0.16d0,-0.37d0), (3.0d0,4.0d0),
188  + (3.0d0,4.0d0), (3.0d0,4.0d0), (3.0d0,4.0d0),
189  + (3.0d0,4.0d0), (3.0d0,4.0d0), (3.0d0,4.0d0),
190  + (-0.17d0,-0.19d0), (0.13d0,-0.39d0),
191  + (5.0d0,6.0d0), (5.0d0,6.0d0), (5.0d0,6.0d0),
192  + (5.0d0,6.0d0), (5.0d0,6.0d0), (5.0d0,6.0d0),
193  + (0.11d0,-0.03d0), (-0.17d0,0.46d0),
194  + (-0.17d0,-0.19d0), (7.0d0,8.0d0), (7.0d0,8.0d0),
195  + (7.0d0,8.0d0), (7.0d0,8.0d0), (7.0d0,8.0d0),
196  + (0.19d0,-0.17d0), (0.20d0,-0.35d0),
197  + (0.35d0,0.20d0), (0.14d0,0.08d0),
198  + (2.0d0,3.0d0), (2.0d0,3.0d0), (2.0d0,3.0d0),
199  + (2.0d0,3.0d0)/
200  DATA ((ctrue5(i,j,2),i=1,8),j=1,5)/(0.1d0,0.1d0),
201  + (4.0d0,5.0d0), (4.0d0,5.0d0), (4.0d0,5.0d0),
202  + (4.0d0,5.0d0), (4.0d0,5.0d0), (4.0d0,5.0d0),
203  + (4.0d0,5.0d0), (-0.16d0,-0.37d0), (6.0d0,7.0d0),
204  + (6.0d0,7.0d0), (6.0d0,7.0d0), (6.0d0,7.0d0),
205  + (6.0d0,7.0d0), (6.0d0,7.0d0), (6.0d0,7.0d0),
206  + (-0.17d0,-0.19d0), (8.0d0,9.0d0),
207  + (0.13d0,-0.39d0), (2.0d0,5.0d0), (2.0d0,5.0d0),
208  + (2.0d0,5.0d0), (2.0d0,5.0d0), (2.0d0,5.0d0),
209  + (0.11d0,-0.03d0), (3.0d0,6.0d0),
210  + (-0.17d0,0.46d0), (4.0d0,7.0d0),
211  + (-0.17d0,-0.19d0), (7.0d0,2.0d0), (7.0d0,2.0d0),
212  + (7.0d0,2.0d0), (0.19d0,-0.17d0), (5.0d0,8.0d0),
213  + (0.20d0,-0.35d0), (6.0d0,9.0d0),
214  + (0.35d0,0.20d0), (8.0d0,3.0d0),
215  + (0.14d0,0.08d0), (9.0d0,4.0d0)/
216  DATA ((ctrue6(i,j,1),i=1,8),j=1,5)/(0.1d0,0.1d0),
217  + (1.0d0,2.0d0), (1.0d0,2.0d0), (1.0d0,2.0d0),
218  + (1.0d0,2.0d0), (1.0d0,2.0d0), (1.0d0,2.0d0),
219  + (1.0d0,2.0d0), (0.09d0,-0.12d0), (3.0d0,4.0d0),
220  + (3.0d0,4.0d0), (3.0d0,4.0d0), (3.0d0,4.0d0),
221  + (3.0d0,4.0d0), (3.0d0,4.0d0), (3.0d0,4.0d0),
222  + (0.03d0,-0.09d0), (0.15d0,-0.03d0),
223  + (5.0d0,6.0d0), (5.0d0,6.0d0), (5.0d0,6.0d0),
224  + (5.0d0,6.0d0), (5.0d0,6.0d0), (5.0d0,6.0d0),
225  + (0.03d0,0.03d0), (-0.18d0,0.03d0),
226  + (0.03d0,-0.09d0), (7.0d0,8.0d0), (7.0d0,8.0d0),
227  + (7.0d0,8.0d0), (7.0d0,8.0d0), (7.0d0,8.0d0),
228  + (0.09d0,0.03d0), (0.15d0,0.00d0),
229  + (0.00d0,0.15d0), (0.00d0,0.06d0), (2.0d0,3.0d0),
230  + (2.0d0,3.0d0), (2.0d0,3.0d0), (2.0d0,3.0d0)/
231  DATA ((ctrue6(i,j,2),i=1,8),j=1,5)/(0.1d0,0.1d0),
232  + (4.0d0,5.0d0), (4.0d0,5.0d0), (4.0d0,5.0d0),
233  + (4.0d0,5.0d0), (4.0d0,5.0d0), (4.0d0,5.0d0),
234  + (4.0d0,5.0d0), (0.09d0,-0.12d0), (6.0d0,7.0d0),
235  + (6.0d0,7.0d0), (6.0d0,7.0d0), (6.0d0,7.0d0),
236  + (6.0d0,7.0d0), (6.0d0,7.0d0), (6.0d0,7.0d0),
237  + (0.03d0,-0.09d0), (8.0d0,9.0d0),
238  + (0.15d0,-0.03d0), (2.0d0,5.0d0), (2.0d0,5.0d0),
239  + (2.0d0,5.0d0), (2.0d0,5.0d0), (2.0d0,5.0d0),
240  + (0.03d0,0.03d0), (3.0d0,6.0d0),
241  + (-0.18d0,0.03d0), (4.0d0,7.0d0),
242  + (0.03d0,-0.09d0), (7.0d0,2.0d0), (7.0d0,2.0d0),
243  + (7.0d0,2.0d0), (0.09d0,0.03d0), (5.0d0,8.0d0),
244  + (0.15d0,0.00d0), (6.0d0,9.0d0), (0.00d0,0.15d0),
245  + (8.0d0,3.0d0), (0.00d0,0.06d0), (9.0d0,4.0d0)/
246  DATA itrue3/0, 1, 2, 2, 2/
247  DATA itruec/0, 1, 1, 1, 1/
248 * .. Executable Statements ..
249  DO 60 incx = 1, 2
250  DO 40 np1 = 1, 5
251  n = np1 - 1
252  len = 2*max(n,1)
253 * .. Set vector arguments ..
254  DO 20 i = 1, len
255  cx(i) = cv(i,np1,incx)
256  20 CONTINUE
257  IF (icase.EQ.6) THEN
258 * .. DZNRM2 ..
259  CALL stest1(dznrm2(n,cx,incx),strue2(np1),strue2(np1),
260  + sfac)
261  ELSE IF (icase.EQ.7) THEN
262 * .. DZASUM ..
263  CALL stest1(dzasum(n,cx,incx),strue4(np1),strue4(np1),
264  + sfac)
265  ELSE IF (icase.EQ.8) THEN
266 * .. ZSCAL ..
267  CALL zscal(n,ca,cx,incx)
268  CALL ctest(len,cx,ctrue5(1,np1,incx),ctrue5(1,np1,incx),
269  + sfac)
270  ELSE IF (icase.EQ.9) THEN
271 * .. ZDSCAL ..
272  CALL zdscal(n,sa,cx,incx)
273  CALL ctest(len,cx,ctrue6(1,np1,incx),ctrue6(1,np1,incx),
274  + sfac)
275  ELSE IF (icase.EQ.10) THEN
276 * .. IZAMAX ..
277  CALL itest1(izamax(n,cx,incx),itrue3(np1))
278  DO 160 i = 1, len
279  cx(i) = (42.0d0,43.0d0)
280  160 CONTINUE
281  CALL itest1(izamax(n,cx,incx),itruec(np1))
282  ELSE
283  WRITE (nout,*) ' Shouldn''t be here in CHECK1'
284  stop
285  END IF
286 *
287  40 CONTINUE
288  IF (icase.EQ.10) THEN
289  n = 8
290  ix = 1
291  DO 180 i = 1, n
292  cxr(ix) = cvr(i)
293  ix = ix + incx
294  180 CONTINUE
295  CALL itest1(izamax(n,cxr,incx),3)
296  END IF
297  60 CONTINUE
298 *
299  incx = 1
300  IF (icase.EQ.8) THEN
301 * ZSCAL
302 * Add a test for alpha equal to zero.
303  ca = (0.0d0,0.0d0)
304  DO 80 i = 1, 5
305  mwpct(i) = (0.0d0,0.0d0)
306  mwpcs(i) = (1.0d0,1.0d0)
307  80 CONTINUE
308  CALL zscal(5,ca,cx,incx)
309  CALL ctest(5,cx,mwpct,mwpcs,sfac)
310  ELSE IF (icase.EQ.9) THEN
311 * ZDSCAL
312 * Add a test for alpha equal to zero.
313  sa = 0.0d0
314  DO 100 i = 1, 5
315  mwpct(i) = (0.0d0,0.0d0)
316  mwpcs(i) = (1.0d0,1.0d0)
317  100 CONTINUE
318  CALL zdscal(5,sa,cx,incx)
319  CALL ctest(5,cx,mwpct,mwpcs,sfac)
320 * Add a test for alpha equal to one.
321  sa = 1.0d0
322  DO 120 i = 1, 5
323  mwpct(i) = cx(i)
324  mwpcs(i) = cx(i)
325  120 CONTINUE
326  CALL zdscal(5,sa,cx,incx)
327  CALL ctest(5,cx,mwpct,mwpcs,sfac)
328 * Add a test for alpha equal to minus one.
329  sa = -1.0d0
330  DO 140 i = 1, 5
331  mwpct(i) = -cx(i)
332  mwpcs(i) = -cx(i)
333  140 CONTINUE
334  CALL zdscal(5,sa,cx,incx)
335  CALL ctest(5,cx,mwpct,mwpcs,sfac)
336  END IF
337  RETURN
338 *
339 * End of CHECK1
340 *
stest1
subroutine stest1(SCOMP1, STRUE1, SSIZE, SFAC)
Definition: cblat1.f:668
ctest
subroutine ctest(LEN, CCOMP, CTRUE, CSIZE, SFAC)
Definition: cblat1.f:709
itest1
subroutine itest1(ICOMP, ITRUE)
Definition: cblat1.f:743
izamax
integer function izamax(N, ZX, INCX)
IZAMAX
Definition: izamax.f:71
zdscal
subroutine zdscal(N, DA, ZX, INCX)
ZDSCAL
Definition: zdscal.f:78
zscal
subroutine zscal(N, ZA, ZX, INCX)
ZSCAL
Definition: zscal.f:78
dzasum
double precision function dzasum(N, ZX, INCX)
DZASUM
Definition: dzasum.f:72
dznrm2
real(wp) function dznrm2(n, x, incx)
DZNRM2
Definition: dznrm2.f90:90
Here is the call graph for this function: