LAPACK  3.9.1
LAPACK: Linear Algebra PACKage

◆ check1()

subroutine check1 ( double precision  SFAC)

Definition at line 115 of file zblat1.f.

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