LAPACK  3.8.0
LAPACK: Linear Algebra PACKage

◆ check1()

subroutine check1 ( double precision  SFAC)

Definition at line 119 of file zblat1.f.

119 * .. Parameters ..
120  INTEGER nout
121  parameter(nout=6)
122 * .. Scalar Arguments ..
123  DOUBLE PRECISION sfac
124 * .. Scalars in Common ..
125  INTEGER icase, incx, incy, mode, n
126  LOGICAL pass
127 * .. Local Scalars ..
128  COMPLEX*16 ca
129  DOUBLE PRECISION sa
130  INTEGER i, j, len, np1
131 * .. Local Arrays ..
132  COMPLEX*16 ctrue5(8,5,2), ctrue6(8,5,2), cv(8,5,2), cx(8),
133  + mwpcs(5), mwpct(5)
134  DOUBLE PRECISION strue2(5), strue4(5)
135  INTEGER itrue3(5)
136 * .. External Functions ..
137  DOUBLE PRECISION dzasum, dznrm2
138  INTEGER izamax
139  EXTERNAL dzasum, dznrm2, izamax
140 * .. External Subroutines ..
141  EXTERNAL zscal, zdscal, ctest, itest1, stest1
142 * .. Intrinsic Functions ..
143  INTRINSIC max
144 * .. Common blocks ..
145  COMMON /combla/icase, n, incx, incy, mode, pass
146 * .. Data statements ..
147  DATA sa, ca/0.3d0, (0.4d0,-0.7d0)/
148  DATA ((cv(i,j,1),i=1,8),j=1,5)/(0.1d0,0.1d0),
149  + (1.0d0,2.0d0), (1.0d0,2.0d0), (1.0d0,2.0d0),
150  + (1.0d0,2.0d0), (1.0d0,2.0d0), (1.0d0,2.0d0),
151  + (1.0d0,2.0d0), (0.3d0,-0.4d0), (3.0d0,4.0d0),
152  + (3.0d0,4.0d0), (3.0d0,4.0d0), (3.0d0,4.0d0),
153  + (3.0d0,4.0d0), (3.0d0,4.0d0), (3.0d0,4.0d0),
154  + (0.1d0,-0.3d0), (0.5d0,-0.1d0), (5.0d0,6.0d0),
155  + (5.0d0,6.0d0), (5.0d0,6.0d0), (5.0d0,6.0d0),
156  + (5.0d0,6.0d0), (5.0d0,6.0d0), (0.1d0,0.1d0),
157  + (-0.6d0,0.1d0), (0.1d0,-0.3d0), (7.0d0,8.0d0),
158  + (7.0d0,8.0d0), (7.0d0,8.0d0), (7.0d0,8.0d0),
159  + (7.0d0,8.0d0), (0.3d0,0.1d0), (0.5d0,0.0d0),
160  + (0.0d0,0.5d0), (0.0d0,0.2d0), (2.0d0,3.0d0),
161  + (2.0d0,3.0d0), (2.0d0,3.0d0), (2.0d0,3.0d0)/
162  DATA ((cv(i,j,2),i=1,8),j=1,5)/(0.1d0,0.1d0),
163  + (4.0d0,5.0d0), (4.0d0,5.0d0), (4.0d0,5.0d0),
164  + (4.0d0,5.0d0), (4.0d0,5.0d0), (4.0d0,5.0d0),
165  + (4.0d0,5.0d0), (0.3d0,-0.4d0), (6.0d0,7.0d0),
166  + (6.0d0,7.0d0), (6.0d0,7.0d0), (6.0d0,7.0d0),
167  + (6.0d0,7.0d0), (6.0d0,7.0d0), (6.0d0,7.0d0),
168  + (0.1d0,-0.3d0), (8.0d0,9.0d0), (0.5d0,-0.1d0),
169  + (2.0d0,5.0d0), (2.0d0,5.0d0), (2.0d0,5.0d0),
170  + (2.0d0,5.0d0), (2.0d0,5.0d0), (0.1d0,0.1d0),
171  + (3.0d0,6.0d0), (-0.6d0,0.1d0), (4.0d0,7.0d0),
172  + (0.1d0,-0.3d0), (7.0d0,2.0d0), (7.0d0,2.0d0),
173  + (7.0d0,2.0d0), (0.3d0,0.1d0), (5.0d0,8.0d0),
174  + (0.5d0,0.0d0), (6.0d0,9.0d0), (0.0d0,0.5d0),
175  + (8.0d0,3.0d0), (0.0d0,0.2d0), (9.0d0,4.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 * .. Executable Statements ..
242  DO 60 incx = 1, 2
243  DO 40 np1 = 1, 5
244  n = np1 - 1
245  len = 2*max(n,1)
246 * .. Set vector arguments ..
247  DO 20 i = 1, len
248  cx(i) = cv(i,np1,incx)
249  20 CONTINUE
250  IF (icase.EQ.6) THEN
251 * .. DZNRM2 ..
252  CALL stest1(dznrm2(n,cx,incx),strue2(np1),strue2(np1),
253  + sfac)
254  ELSE IF (icase.EQ.7) THEN
255 * .. DZASUM ..
256  CALL stest1(dzasum(n,cx,incx),strue4(np1),strue4(np1),
257  + sfac)
258  ELSE IF (icase.EQ.8) THEN
259 * .. ZSCAL ..
260  CALL zscal(n,ca,cx,incx)
261  CALL ctest(len,cx,ctrue5(1,np1,incx),ctrue5(1,np1,incx),
262  + sfac)
263  ELSE IF (icase.EQ.9) THEN
264 * .. ZDSCAL ..
265  CALL zdscal(n,sa,cx,incx)
266  CALL ctest(len,cx,ctrue6(1,np1,incx),ctrue6(1,np1,incx),
267  + sfac)
268  ELSE IF (icase.EQ.10) THEN
269 * .. IZAMAX ..
270  CALL itest1(izamax(n,cx,incx),itrue3(np1))
271  ELSE
272  WRITE (nout,*) ' Shouldn''t be here in CHECK1'
273  stop
274  END IF
275 *
276  40 CONTINUE
277  60 CONTINUE
278 *
279  incx = 1
280  IF (icase.EQ.8) THEN
281 * ZSCAL
282 * Add a test for alpha equal to zero.
283  ca = (0.0d0,0.0d0)
284  DO 80 i = 1, 5
285  mwpct(i) = (0.0d0,0.0d0)
286  mwpcs(i) = (1.0d0,1.0d0)
287  80 CONTINUE
288  CALL zscal(5,ca,cx,incx)
289  CALL ctest(5,cx,mwpct,mwpcs,sfac)
290  ELSE IF (icase.EQ.9) THEN
291 * ZDSCAL
292 * Add a test for alpha equal to zero.
293  sa = 0.0d0
294  DO 100 i = 1, 5
295  mwpct(i) = (0.0d0,0.0d0)
296  mwpcs(i) = (1.0d0,1.0d0)
297  100 CONTINUE
298  CALL zdscal(5,sa,cx,incx)
299  CALL ctest(5,cx,mwpct,mwpcs,sfac)
300 * Add a test for alpha equal to one.
301  sa = 1.0d0
302  DO 120 i = 1, 5
303  mwpct(i) = cx(i)
304  mwpcs(i) = cx(i)
305  120 CONTINUE
306  CALL zdscal(5,sa,cx,incx)
307  CALL ctest(5,cx,mwpct,mwpcs,sfac)
308 * Add a test for alpha equal to minus one.
309  sa = -1.0d0
310  DO 140 i = 1, 5
311  mwpct(i) = -cx(i)
312  mwpcs(i) = -cx(i)
313  140 CONTINUE
314  CALL zdscal(5,sa,cx,incx)
315  CALL ctest(5,cx,mwpct,mwpcs,sfac)
316  END IF
317  RETURN
subroutine itest1(ICOMP, ITRUE)
Definition: cblat1.f:686
integer function izamax(N, ZX, INCX)
IZAMAX
Definition: izamax.f:73
double precision function dznrm2(N, X, INCX)
DZNRM2
Definition: dznrm2.f:77
subroutine stest1(SCOMP1, STRUE1, SSIZE, SFAC)
Definition: cblat1.f:620
double precision function dzasum(N, ZX, INCX)
DZASUM
Definition: dzasum.f:74
subroutine ctest(LEN, CCOMP, CTRUE, CSIZE, SFAC)
Definition: cblat1.f:655
subroutine zdscal(N, DA, ZX, INCX)
ZDSCAL
Definition: zdscal.f:80
subroutine zscal(N, ZA, ZX, INCX)
ZSCAL
Definition: zscal.f:80
Here is the call graph for this function: