LAPACK  3.5.0
LAPACK: Linear Algebra PACKage
zblat1.f File Reference

Go to the source code of this file.

Functions/Subroutines

program zblat1
 ZBLAT1 More...
 
subroutine header
 
subroutine check1 (SFAC)
 
subroutine check2 (SFAC)
 
subroutine stest (LEN, SCOMP, STRUE, SSIZE, SFAC)
 
subroutine stest1 (SCOMP1, STRUE1, SSIZE, SFAC)
 
double precision function sdiff (SA, SB)
 
subroutine ctest (LEN, CCOMP, CTRUE, CSIZE, SFAC)
 
subroutine itest1 (ICOMP, ITRUE)
 

Function/Subroutine Documentation

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
integer function izamax(N, ZX, INCX)
IZAMAX
Definition: izamax.f:53
subroutine zdscal(N, DA, ZX, INCX)
ZDSCAL
Definition: zdscal.f:54
subroutine itest1(ICOMP, ITRUE)
Definition: cblat1.f:686
subroutine ctest(LEN, CCOMP, CTRUE, CSIZE, SFAC)
Definition: cblat1.f:655
double precision function dzasum(N, ZX, INCX)
DZASUM
Definition: dzasum.f:53
subroutine stest1(SCOMP1, STRUE1, SSIZE, SFAC)
Definition: cblat1.f:620
double precision function dznrm2(N, X, INCX)
DZNRM2
Definition: dznrm2.f:56
subroutine zscal(N, ZA, ZX, INCX)
ZSCAL
Definition: zscal.f:54

Here is the call graph for this function:

subroutine check2 ( double precision  SFAC)

Definition at line 320 of file zblat1.f.

320 * .. Parameters ..
321  INTEGER nout
322  parameter(nout=6)
323 * .. Scalar Arguments ..
324  DOUBLE PRECISION sfac
325 * .. Scalars in Common ..
326  INTEGER icase, incx, incy, mode, n
327  LOGICAL pass
328 * .. Local Scalars ..
329  COMPLEX*16 ca
330  INTEGER i, j, ki, kn, ksize, lenx, leny, mx, my
331 * .. Local Arrays ..
332  COMPLEX*16 cdot(1), csize1(4), csize2(7,2), csize3(14),
333  + ct10x(7,4,4), ct10y(7,4,4), ct6(4,4), ct7(4,4),
334  + ct8(7,4,4), cx(7), cx1(7), cy(7), cy1(7)
335  INTEGER incxs(4), incys(4), lens(4,2), ns(4)
336 * .. External Functions ..
337  COMPLEX*16 zdotc, zdotu
338  EXTERNAL zdotc, zdotu
339 * .. External Subroutines ..
340  EXTERNAL zaxpy, zcopy, zswap, ctest
341 * .. Intrinsic Functions ..
342  INTRINSIC abs, min
343 * .. Common blocks ..
344  COMMON /combla/icase, n, incx, incy, mode, pass
345 * .. Data statements ..
346  DATA ca/(0.4d0,-0.7d0)/
347  DATA incxs/1, 2, -2, -1/
348  DATA incys/1, -2, 1, -2/
349  DATA lens/1, 1, 2, 4, 1, 1, 3, 7/
350  DATA ns/0, 1, 2, 4/
351  DATA cx1/(0.7d0,-0.8d0), (-0.4d0,-0.7d0),
352  + (-0.1d0,-0.9d0), (0.2d0,-0.8d0),
353  + (-0.9d0,-0.4d0), (0.1d0,0.4d0), (-0.6d0,0.6d0)/
354  DATA cy1/(0.6d0,-0.6d0), (-0.9d0,0.5d0),
355  + (0.7d0,-0.6d0), (0.1d0,-0.5d0), (-0.1d0,-0.2d0),
356  + (-0.5d0,-0.3d0), (0.8d0,-0.7d0)/
357  DATA ((ct8(i,j,1),i=1,7),j=1,4)/(0.6d0,-0.6d0),
358  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
359  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
360  + (0.32d0,-1.41d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
361  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
362  + (0.0d0,0.0d0), (0.32d0,-1.41d0),
363  + (-1.55d0,0.5d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
364  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
365  + (0.32d0,-1.41d0), (-1.55d0,0.5d0),
366  + (0.03d0,-0.89d0), (-0.38d0,-0.96d0),
367  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0)/
368  DATA ((ct8(i,j,2),i=1,7),j=1,4)/(0.6d0,-0.6d0),
369  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
370  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
371  + (0.32d0,-1.41d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
372  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
373  + (0.0d0,0.0d0), (-0.07d0,-0.89d0),
374  + (-0.9d0,0.5d0), (0.42d0,-1.41d0), (0.0d0,0.0d0),
375  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
376  + (0.78d0,0.06d0), (-0.9d0,0.5d0),
377  + (0.06d0,-0.13d0), (0.1d0,-0.5d0),
378  + (-0.77d0,-0.49d0), (-0.5d0,-0.3d0),
379  + (0.52d0,-1.51d0)/
380  DATA ((ct8(i,j,3),i=1,7),j=1,4)/(0.6d0,-0.6d0),
381  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
382  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
383  + (0.32d0,-1.41d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
384  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
385  + (0.0d0,0.0d0), (-0.07d0,-0.89d0),
386  + (-1.18d0,-0.31d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
387  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
388  + (0.78d0,0.06d0), (-1.54d0,0.97d0),
389  + (0.03d0,-0.89d0), (-0.18d0,-1.31d0),
390  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0)/
391  DATA ((ct8(i,j,4),i=1,7),j=1,4)/(0.6d0,-0.6d0),
392  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
393  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
394  + (0.32d0,-1.41d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
395  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
396  + (0.0d0,0.0d0), (0.32d0,-1.41d0), (-0.9d0,0.5d0),
397  + (0.05d0,-0.6d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
398  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.32d0,-1.41d0),
399  + (-0.9d0,0.5d0), (0.05d0,-0.6d0), (0.1d0,-0.5d0),
400  + (-0.77d0,-0.49d0), (-0.5d0,-0.3d0),
401  + (0.32d0,-1.16d0)/
402  DATA ct7/(0.0d0,0.0d0), (-0.06d0,-0.90d0),
403  + (0.65d0,-0.47d0), (-0.34d0,-1.22d0),
404  + (0.0d0,0.0d0), (-0.06d0,-0.90d0),
405  + (-0.59d0,-1.46d0), (-1.04d0,-0.04d0),
406  + (0.0d0,0.0d0), (-0.06d0,-0.90d0),
407  + (-0.83d0,0.59d0), (0.07d0,-0.37d0),
408  + (0.0d0,0.0d0), (-0.06d0,-0.90d0),
409  + (-0.76d0,-1.15d0), (-1.33d0,-1.82d0)/
410  DATA ct6/(0.0d0,0.0d0), (0.90d0,0.06d0),
411  + (0.91d0,-0.77d0), (1.80d0,-0.10d0),
412  + (0.0d0,0.0d0), (0.90d0,0.06d0), (1.45d0,0.74d0),
413  + (0.20d0,0.90d0), (0.0d0,0.0d0), (0.90d0,0.06d0),
414  + (-0.55d0,0.23d0), (0.83d0,-0.39d0),
415  + (0.0d0,0.0d0), (0.90d0,0.06d0), (1.04d0,0.79d0),
416  + (1.95d0,1.22d0)/
417  DATA ((ct10x(i,j,1),i=1,7),j=1,4)/(0.7d0,-0.8d0),
418  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
419  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
420  + (0.6d0,-0.6d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
421  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
422  + (0.0d0,0.0d0), (0.6d0,-0.6d0), (-0.9d0,0.5d0),
423  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
424  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.6d0,-0.6d0),
425  + (-0.9d0,0.5d0), (0.7d0,-0.6d0), (0.1d0,-0.5d0),
426  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0)/
427  DATA ((ct10x(i,j,2),i=1,7),j=1,4)/(0.7d0,-0.8d0),
428  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
429  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
430  + (0.6d0,-0.6d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
431  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
432  + (0.0d0,0.0d0), (0.7d0,-0.6d0), (-0.4d0,-0.7d0),
433  + (0.6d0,-0.6d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
434  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.8d0,-0.7d0),
435  + (-0.4d0,-0.7d0), (-0.1d0,-0.2d0),
436  + (0.2d0,-0.8d0), (0.7d0,-0.6d0), (0.1d0,0.4d0),
437  + (0.6d0,-0.6d0)/
438  DATA ((ct10x(i,j,3),i=1,7),j=1,4)/(0.7d0,-0.8d0),
439  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
440  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
441  + (0.6d0,-0.6d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
442  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
443  + (0.0d0,0.0d0), (-0.9d0,0.5d0), (-0.4d0,-0.7d0),
444  + (0.6d0,-0.6d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
445  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.1d0,-0.5d0),
446  + (-0.4d0,-0.7d0), (0.7d0,-0.6d0), (0.2d0,-0.8d0),
447  + (-0.9d0,0.5d0), (0.1d0,0.4d0), (0.6d0,-0.6d0)/
448  DATA ((ct10x(i,j,4),i=1,7),j=1,4)/(0.7d0,-0.8d0),
449  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
450  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
451  + (0.6d0,-0.6d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
452  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
453  + (0.0d0,0.0d0), (0.6d0,-0.6d0), (0.7d0,-0.6d0),
454  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
455  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.6d0,-0.6d0),
456  + (0.7d0,-0.6d0), (-0.1d0,-0.2d0), (0.8d0,-0.7d0),
457  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0)/
458  DATA ((ct10y(i,j,1),i=1,7),j=1,4)/(0.6d0,-0.6d0),
459  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
460  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
461  + (0.7d0,-0.8d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
462  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
463  + (0.0d0,0.0d0), (0.7d0,-0.8d0), (-0.4d0,-0.7d0),
464  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
465  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.7d0,-0.8d0),
466  + (-0.4d0,-0.7d0), (-0.1d0,-0.9d0),
467  + (0.2d0,-0.8d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
468  + (0.0d0,0.0d0)/
469  DATA ((ct10y(i,j,2),i=1,7),j=1,4)/(0.6d0,-0.6d0),
470  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
471  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
472  + (0.7d0,-0.8d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
473  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
474  + (0.0d0,0.0d0), (-0.1d0,-0.9d0), (-0.9d0,0.5d0),
475  + (0.7d0,-0.8d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
476  + (0.0d0,0.0d0), (0.0d0,0.0d0), (-0.6d0,0.6d0),
477  + (-0.9d0,0.5d0), (-0.9d0,-0.4d0), (0.1d0,-0.5d0),
478  + (-0.1d0,-0.9d0), (-0.5d0,-0.3d0),
479  + (0.7d0,-0.8d0)/
480  DATA ((ct10y(i,j,3),i=1,7),j=1,4)/(0.6d0,-0.6d0),
481  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
482  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
483  + (0.7d0,-0.8d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
484  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
485  + (0.0d0,0.0d0), (-0.1d0,-0.9d0), (0.7d0,-0.8d0),
486  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
487  + (0.0d0,0.0d0), (0.0d0,0.0d0), (-0.6d0,0.6d0),
488  + (-0.9d0,-0.4d0), (-0.1d0,-0.9d0),
489  + (0.7d0,-0.8d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
490  + (0.0d0,0.0d0)/
491  DATA ((ct10y(i,j,4),i=1,7),j=1,4)/(0.6d0,-0.6d0),
492  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
493  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
494  + (0.7d0,-0.8d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
495  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
496  + (0.0d0,0.0d0), (0.7d0,-0.8d0), (-0.9d0,0.5d0),
497  + (-0.4d0,-0.7d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
498  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.7d0,-0.8d0),
499  + (-0.9d0,0.5d0), (-0.4d0,-0.7d0), (0.1d0,-0.5d0),
500  + (-0.1d0,-0.9d0), (-0.5d0,-0.3d0),
501  + (0.2d0,-0.8d0)/
502  DATA csize1/(0.0d0,0.0d0), (0.9d0,0.9d0),
503  + (1.63d0,1.73d0), (2.90d0,2.78d0)/
504  DATA csize3/(0.0d0,0.0d0), (0.0d0,0.0d0),
505  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
506  + (0.0d0,0.0d0), (0.0d0,0.0d0), (1.17d0,1.17d0),
507  + (1.17d0,1.17d0), (1.17d0,1.17d0),
508  + (1.17d0,1.17d0), (1.17d0,1.17d0),
509  + (1.17d0,1.17d0), (1.17d0,1.17d0)/
510  DATA csize2/(0.0d0,0.0d0), (0.0d0,0.0d0),
511  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
512  + (0.0d0,0.0d0), (0.0d0,0.0d0), (1.54d0,1.54d0),
513  + (1.54d0,1.54d0), (1.54d0,1.54d0),
514  + (1.54d0,1.54d0), (1.54d0,1.54d0),
515  + (1.54d0,1.54d0), (1.54d0,1.54d0)/
516 * .. Executable Statements ..
517  DO 60 ki = 1, 4
518  incx = incxs(ki)
519  incy = incys(ki)
520  mx = abs(incx)
521  my = abs(incy)
522 *
523  DO 40 kn = 1, 4
524  n = ns(kn)
525  ksize = min(2,kn)
526  lenx = lens(kn,mx)
527  leny = lens(kn,my)
528 * .. initialize all argument arrays ..
529  DO 20 i = 1, 7
530  cx(i) = cx1(i)
531  cy(i) = cy1(i)
532  20 CONTINUE
533  IF (icase.EQ.1) THEN
534 * .. ZDOTC ..
535  cdot(1) = zdotc(n,cx,incx,cy,incy)
536  CALL ctest(1,cdot,ct6(kn,ki),csize1(kn),sfac)
537  ELSE IF (icase.EQ.2) THEN
538 * .. ZDOTU ..
539  cdot(1) = zdotu(n,cx,incx,cy,incy)
540  CALL ctest(1,cdot,ct7(kn,ki),csize1(kn),sfac)
541  ELSE IF (icase.EQ.3) THEN
542 * .. ZAXPY ..
543  CALL zaxpy(n,ca,cx,incx,cy,incy)
544  CALL ctest(leny,cy,ct8(1,kn,ki),csize2(1,ksize),sfac)
545  ELSE IF (icase.EQ.4) THEN
546 * .. ZCOPY ..
547  CALL zcopy(n,cx,incx,cy,incy)
548  CALL ctest(leny,cy,ct10y(1,kn,ki),csize3,1.0d0)
549  ELSE IF (icase.EQ.5) THEN
550 * .. ZSWAP ..
551  CALL zswap(n,cx,incx,cy,incy)
552  CALL ctest(lenx,cx,ct10x(1,kn,ki),csize3,1.0d0)
553  CALL ctest(leny,cy,ct10y(1,kn,ki),csize3,1.0d0)
554  ELSE
555  WRITE (nout,*) ' Shouldn''t be here in CHECK2'
556  stop
557  END IF
558 *
559  40 CONTINUE
560  60 CONTINUE
561  RETURN
subroutine zswap(N, ZX, INCX, ZY, INCY)
ZSWAP
Definition: zswap.f:52
complex *16 function zdotc(N, ZX, INCX, ZY, INCY)
ZDOTC
Definition: zdotc.f:52
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
Definition: zcopy.f:52
subroutine ctest(LEN, CCOMP, CTRUE, CSIZE, SFAC)
Definition: cblat1.f:655
subroutine zaxpy(N, ZA, ZX, INCX, ZY, INCY)
ZAXPY
Definition: zaxpy.f:53
complex *16 function zdotu(N, ZX, INCX, ZY, INCY)
ZDOTU
Definition: zdotu.f:52

Here is the call graph for this function:

subroutine ctest ( integer  LEN,
complex*16, dimension(len)  CCOMP,
complex*16, dimension(len)  CTRUE,
complex*16, dimension(len)  CSIZE,
double precision  SFAC 
)

Definition at line 655 of file zblat1.f.

655 * **************************** CTEST *****************************
656 *
657 * C.L. LAWSON, JPL, 1978 DEC 6
658 *
659 * .. Scalar Arguments ..
660  DOUBLE PRECISION sfac
661  INTEGER len
662 * .. Array Arguments ..
663  COMPLEX*16 ccomp(len), csize(len), ctrue(len)
664 * .. Local Scalars ..
665  INTEGER i
666 * .. Local Arrays ..
667  DOUBLE PRECISION scomp(20), ssize(20), strue(20)
668 * .. External Subroutines ..
669  EXTERNAL stest
670 * .. Intrinsic Functions ..
671  INTRINSIC dimag, dble
672 * .. Executable Statements ..
673  DO 20 i = 1, len
674  scomp(2*i-1) = dble(ccomp(i))
675  scomp(2*i) = dimag(ccomp(i))
676  strue(2*i-1) = dble(ctrue(i))
677  strue(2*i) = dimag(ctrue(i))
678  ssize(2*i-1) = dble(csize(i))
679  ssize(2*i) = dimag(csize(i))
680  20 CONTINUE
681 *
682  CALL stest(2*len,scomp,strue,ssize,sfac)
683  RETURN
subroutine stest(LEN, SCOMP, STRUE, SSIZE, SFAC)
Definition: cblat1.f:564

Here is the call graph for this function:

subroutine header ( )

Definition at line 91 of file zblat1.f.

91 * .. Parameters ..
92  INTEGER nout
93  parameter(nout=6)
94 * .. Scalars in Common ..
95  INTEGER icase, incx, incy, mode, n
96  LOGICAL pass
97 * .. Local Arrays ..
98  CHARACTER*6 l(10)
99 * .. Common blocks ..
100  COMMON /combla/icase, n, incx, incy, mode, pass
101 * .. Data statements ..
102  DATA l(1)/'ZDOTC '/
103  DATA l(2)/'ZDOTU '/
104  DATA l(3)/'ZAXPY '/
105  DATA l(4)/'ZCOPY '/
106  DATA l(5)/'ZSWAP '/
107  DATA l(6)/'DZNRM2'/
108  DATA l(7)/'DZASUM'/
109  DATA l(8)/'ZSCAL '/
110  DATA l(9)/'ZDSCAL'/
111  DATA l(10)/'IZAMAX'/
112 * .. Executable Statements ..
113  WRITE (nout,99999) icase, l(icase)
114  RETURN
115 *
116 99999 FORMAT (/' Test of subprogram number',i3,12x,a6)
subroutine itest1 ( integer  ICOMP,
integer  ITRUE 
)

Definition at line 686 of file zblat1.f.

686 * ********************************* ITEST1 *************************
687 *
688 * THIS SUBROUTINE COMPARES THE VARIABLES ICOMP AND ITRUE FOR
689 * EQUALITY.
690 * C. L. LAWSON, JPL, 1974 DEC 10
691 *
692 * .. Parameters ..
693  INTEGER nout
694  parameter(nout=6)
695 * .. Scalar Arguments ..
696  INTEGER icomp, itrue
697 * .. Scalars in Common ..
698  INTEGER icase, incx, incy, mode, n
699  LOGICAL pass
700 * .. Local Scalars ..
701  INTEGER id
702 * .. Common blocks ..
703  COMMON /combla/icase, n, incx, incy, mode, pass
704 * .. Executable Statements ..
705  IF (icomp.EQ.itrue) GO TO 40
706 *
707 * HERE ICOMP IS NOT EQUAL TO ITRUE.
708 *
709  IF ( .NOT. pass) GO TO 20
710 * PRINT FAIL MESSAGE AND HEADER.
711  pass = .false.
712  WRITE (nout,99999)
713  WRITE (nout,99998)
714  20 id = icomp - itrue
715  WRITE (nout,99997) icase, n, incx, incy, mode, icomp, itrue, id
716  40 CONTINUE
717  RETURN
718 *
719 99999 FORMAT (' FAIL')
720 99998 FORMAT (/' CASE N INCX INCY MODE ',
721  + ' COMP TRUE DIFFERENCE',
722  + /1x)
723 99997 FORMAT (1x,i4,i3,3i5,2i36,i12)
double precision function sdiff ( double precision  SA,
double precision  SB 
)

Definition at line 645 of file zblat1.f.

645 * ********************************* SDIFF **************************
646 * COMPUTES DIFFERENCE OF TWO NUMBERS. C. L. LAWSON, JPL 1974 FEB 15
647 *
648 * .. Scalar Arguments ..
649  DOUBLE PRECISION sa, sb
650 * .. Executable Statements ..
651  sdiff = sa - sb
652  RETURN
real function sdiff(SA, SB)
Definition: cblat1.f:645

Here is the call graph for this function:

subroutine stest ( integer  LEN,
double precision, dimension(len)  SCOMP,
double precision, dimension(len)  STRUE,
double precision, dimension(len)  SSIZE,
double precision  SFAC 
)

Definition at line 564 of file zblat1.f.

564 * ********************************* STEST **************************
565 *
566 * THIS SUBR COMPARES ARRAYS SCOMP() AND STRUE() OF LENGTH LEN TO
567 * SEE IF THE TERM BY TERM DIFFERENCES, MULTIPLIED BY SFAC, ARE
568 * NEGLIGIBLE.
569 *
570 * C. L. LAWSON, JPL, 1974 DEC 10
571 *
572 * .. Parameters ..
573  INTEGER nout
574  DOUBLE PRECISION zero
575  parameter(nout=6, zero=0.0d0)
576 * .. Scalar Arguments ..
577  DOUBLE PRECISION sfac
578  INTEGER len
579 * .. Array Arguments ..
580  DOUBLE PRECISION scomp(len), ssize(len), strue(len)
581 * .. Scalars in Common ..
582  INTEGER icase, incx, incy, mode, n
583  LOGICAL pass
584 * .. Local Scalars ..
585  DOUBLE PRECISION sd
586  INTEGER i
587 * .. External Functions ..
588  DOUBLE PRECISION sdiff
589  EXTERNAL sdiff
590 * .. Intrinsic Functions ..
591  INTRINSIC abs
592 * .. Common blocks ..
593  COMMON /combla/icase, n, incx, incy, mode, pass
594 * .. Executable Statements ..
595 *
596  DO 40 i = 1, len
597  sd = scomp(i) - strue(i)
598  IF (abs(sfac*sd) .LE. abs(ssize(i))*epsilon(zero))
599  + GO TO 40
600 *
601 * HERE SCOMP(I) IS NOT CLOSE TO STRUE(I).
602 *
603  IF ( .NOT. pass) GO TO 20
604 * PRINT FAIL MESSAGE AND HEADER.
605  pass = .false.
606  WRITE (nout,99999)
607  WRITE (nout,99998)
608  20 WRITE (nout,99997) icase, n, incx, incy, mode, i, scomp(i),
609  + strue(i), sd, ssize(i)
610  40 CONTINUE
611  RETURN
612 *
613 99999 FORMAT (' FAIL')
614 99998 FORMAT (/' CASE N INCX INCY MODE I ',
615  + ' COMP(I) TRUE(I) DIFFERENCE',
616  + ' SIZE(I)',/1x)
617 99997 FORMAT (1x,i4,i3,3i5,i3,2d36.8,2d12.4)
real function sdiff(SA, SB)
Definition: cblat1.f:645
subroutine stest1 ( double precision  SCOMP1,
double precision  STRUE1,
double precision, dimension(*)  SSIZE,
double precision  SFAC 
)

Definition at line 620 of file zblat1.f.

620 * ************************* STEST1 *****************************
621 *
622 * THIS IS AN INTERFACE SUBROUTINE TO ACCOMODATE THE FORTRAN
623 * REQUIREMENT THAT WHEN A DUMMY ARGUMENT IS AN ARRAY, THE
624 * ACTUAL ARGUMENT MUST ALSO BE AN ARRAY OR AN ARRAY ELEMENT.
625 *
626 * C.L. LAWSON, JPL, 1978 DEC 6
627 *
628 * .. Scalar Arguments ..
629  DOUBLE PRECISION scomp1, sfac, strue1
630 * .. Array Arguments ..
631  DOUBLE PRECISION ssize(*)
632 * .. Local Arrays ..
633  DOUBLE PRECISION scomp(1), strue(1)
634 * .. External Subroutines ..
635  EXTERNAL stest
636 * .. Executable Statements ..
637 *
638  scomp(1) = scomp1
639  strue(1) = strue1
640  CALL stest(1,scomp,strue,ssize,sfac)
641 *
642  RETURN
subroutine stest(LEN, SCOMP, STRUE, SSIZE, SFAC)
Definition: cblat1.f:564

Here is the call graph for this function:

program zblat1 ( )

ZBLAT1

Purpose:
    Test program for the COMPLEX*16 Level 1 BLAS.

    Based upon the original BLAS test routine together with:
    F06GAF Example Program Text
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
April 2012

Definition at line 38 of file zblat1.f.

Here is the call graph for this function: