LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ check1()

subroutine check1 ( real  SFAC)

Definition at line 121 of file cblat1.f.

122 * .. Parameters ..
123  INTEGER NOUT
124  parameter(nout=6)
125 * .. Scalar Arguments ..
126  REAL SFAC
127 * .. Scalars in Common ..
128  INTEGER ICASE, INCX, INCY, MODE, N
129  LOGICAL PASS
130 * .. Local Scalars ..
131  COMPLEX CA
132  REAL SA
133  INTEGER I, IX, J, LEN, NP1
134 * .. Local Arrays ..
135  COMPLEX CTRUE5(8,5,2), CTRUE6(8,5,2), CV(8,5,2), CVR(8),
136  + CX(8), CXR(15), MWPCS(5), MWPCT(5)
137  REAL STRUE2(5), STRUE4(5)
138  INTEGER ITRUE3(5), ITRUEC(5)
139 * .. External Functions ..
140  REAL SCASUM, SCNRM2
141  INTEGER ICAMAX
142  EXTERNAL scasum, scnrm2, icamax
143 * .. External Subroutines ..
144  EXTERNAL cscal, csscal, 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.3e0, (0.4e0,-0.7e0)/
151  DATA ((cv(i,j,1),i=1,8),j=1,5)/(0.1e0,0.1e0),
152  + (1.0e0,2.0e0), (1.0e0,2.0e0), (1.0e0,2.0e0),
153  + (1.0e0,2.0e0), (1.0e0,2.0e0), (1.0e0,2.0e0),
154  + (1.0e0,2.0e0), (0.3e0,-0.4e0), (3.0e0,4.0e0),
155  + (3.0e0,4.0e0), (3.0e0,4.0e0), (3.0e0,4.0e0),
156  + (3.0e0,4.0e0), (3.0e0,4.0e0), (3.0e0,4.0e0),
157  + (0.1e0,-0.3e0), (0.5e0,-0.1e0), (5.0e0,6.0e0),
158  + (5.0e0,6.0e0), (5.0e0,6.0e0), (5.0e0,6.0e0),
159  + (5.0e0,6.0e0), (5.0e0,6.0e0), (0.1e0,0.1e0),
160  + (-0.6e0,0.1e0), (0.1e0,-0.3e0), (7.0e0,8.0e0),
161  + (7.0e0,8.0e0), (7.0e0,8.0e0), (7.0e0,8.0e0),
162  + (7.0e0,8.0e0), (0.3e0,0.1e0), (0.5e0,0.0e0),
163  + (0.0e0,0.5e0), (0.0e0,0.2e0), (2.0e0,3.0e0),
164  + (2.0e0,3.0e0), (2.0e0,3.0e0), (2.0e0,3.0e0)/
165  DATA ((cv(i,j,2),i=1,8),j=1,5)/(0.1e0,0.1e0),
166  + (4.0e0,5.0e0), (4.0e0,5.0e0), (4.0e0,5.0e0),
167  + (4.0e0,5.0e0), (4.0e0,5.0e0), (4.0e0,5.0e0),
168  + (4.0e0,5.0e0), (0.3e0,-0.4e0), (6.0e0,7.0e0),
169  + (6.0e0,7.0e0), (6.0e0,7.0e0), (6.0e0,7.0e0),
170  + (6.0e0,7.0e0), (6.0e0,7.0e0), (6.0e0,7.0e0),
171  + (0.1e0,-0.3e0), (8.0e0,9.0e0), (0.5e0,-0.1e0),
172  + (2.0e0,5.0e0), (2.0e0,5.0e0), (2.0e0,5.0e0),
173  + (2.0e0,5.0e0), (2.0e0,5.0e0), (0.1e0,0.1e0),
174  + (3.0e0,6.0e0), (-0.6e0,0.1e0), (4.0e0,7.0e0),
175  + (0.1e0,-0.3e0), (7.0e0,2.0e0), (7.0e0,2.0e0),
176  + (7.0e0,2.0e0), (0.3e0,0.1e0), (5.0e0,8.0e0),
177  + (0.5e0,0.0e0), (6.0e0,9.0e0), (0.0e0,0.5e0),
178  + (8.0e0,3.0e0), (0.0e0,0.2e0), (9.0e0,4.0e0)/
179  DATA cvr/(8.0e0,8.0e0), (-7.0e0,-7.0e0),
180  + (9.0e0,9.0e0), (5.0e0,5.0e0), (9.0e0,9.0e0),
181  + (8.0e0,8.0e0), (7.0e0,7.0e0), (7.0e0,7.0e0)/
182  DATA strue2/0.0e0, 0.5e0, 0.6e0, 0.7e0, 0.8e0/
183  DATA strue4/0.0e0, 0.7e0, 1.0e0, 1.3e0, 1.6e0/
184  DATA ((ctrue5(i,j,1),i=1,8),j=1,5)/(0.1e0,0.1e0),
185  + (1.0e0,2.0e0), (1.0e0,2.0e0), (1.0e0,2.0e0),
186  + (1.0e0,2.0e0), (1.0e0,2.0e0), (1.0e0,2.0e0),
187  + (1.0e0,2.0e0), (-0.16e0,-0.37e0), (3.0e0,4.0e0),
188  + (3.0e0,4.0e0), (3.0e0,4.0e0), (3.0e0,4.0e0),
189  + (3.0e0,4.0e0), (3.0e0,4.0e0), (3.0e0,4.0e0),
190  + (-0.17e0,-0.19e0), (0.13e0,-0.39e0),
191  + (5.0e0,6.0e0), (5.0e0,6.0e0), (5.0e0,6.0e0),
192  + (5.0e0,6.0e0), (5.0e0,6.0e0), (5.0e0,6.0e0),
193  + (0.11e0,-0.03e0), (-0.17e0,0.46e0),
194  + (-0.17e0,-0.19e0), (7.0e0,8.0e0), (7.0e0,8.0e0),
195  + (7.0e0,8.0e0), (7.0e0,8.0e0), (7.0e0,8.0e0),
196  + (0.19e0,-0.17e0), (0.20e0,-0.35e0),
197  + (0.35e0,0.20e0), (0.14e0,0.08e0),
198  + (2.0e0,3.0e0), (2.0e0,3.0e0), (2.0e0,3.0e0),
199  + (2.0e0,3.0e0)/
200  DATA ((ctrue5(i,j,2),i=1,8),j=1,5)/(0.1e0,0.1e0),
201  + (4.0e0,5.0e0), (4.0e0,5.0e0), (4.0e0,5.0e0),
202  + (4.0e0,5.0e0), (4.0e0,5.0e0), (4.0e0,5.0e0),
203  + (4.0e0,5.0e0), (-0.16e0,-0.37e0), (6.0e0,7.0e0),
204  + (6.0e0,7.0e0), (6.0e0,7.0e0), (6.0e0,7.0e0),
205  + (6.0e0,7.0e0), (6.0e0,7.0e0), (6.0e0,7.0e0),
206  + (-0.17e0,-0.19e0), (8.0e0,9.0e0),
207  + (0.13e0,-0.39e0), (2.0e0,5.0e0), (2.0e0,5.0e0),
208  + (2.0e0,5.0e0), (2.0e0,5.0e0), (2.0e0,5.0e0),
209  + (0.11e0,-0.03e0), (3.0e0,6.0e0),
210  + (-0.17e0,0.46e0), (4.0e0,7.0e0),
211  + (-0.17e0,-0.19e0), (7.0e0,2.0e0), (7.0e0,2.0e0),
212  + (7.0e0,2.0e0), (0.19e0,-0.17e0), (5.0e0,8.0e0),
213  + (0.20e0,-0.35e0), (6.0e0,9.0e0),
214  + (0.35e0,0.20e0), (8.0e0,3.0e0),
215  + (0.14e0,0.08e0), (9.0e0,4.0e0)/
216  DATA ((ctrue6(i,j,1),i=1,8),j=1,5)/(0.1e0,0.1e0),
217  + (1.0e0,2.0e0), (1.0e0,2.0e0), (1.0e0,2.0e0),
218  + (1.0e0,2.0e0), (1.0e0,2.0e0), (1.0e0,2.0e0),
219  + (1.0e0,2.0e0), (0.09e0,-0.12e0), (3.0e0,4.0e0),
220  + (3.0e0,4.0e0), (3.0e0,4.0e0), (3.0e0,4.0e0),
221  + (3.0e0,4.0e0), (3.0e0,4.0e0), (3.0e0,4.0e0),
222  + (0.03e0,-0.09e0), (0.15e0,-0.03e0),
223  + (5.0e0,6.0e0), (5.0e0,6.0e0), (5.0e0,6.0e0),
224  + (5.0e0,6.0e0), (5.0e0,6.0e0), (5.0e0,6.0e0),
225  + (0.03e0,0.03e0), (-0.18e0,0.03e0),
226  + (0.03e0,-0.09e0), (7.0e0,8.0e0), (7.0e0,8.0e0),
227  + (7.0e0,8.0e0), (7.0e0,8.0e0), (7.0e0,8.0e0),
228  + (0.09e0,0.03e0), (0.15e0,0.00e0),
229  + (0.00e0,0.15e0), (0.00e0,0.06e0), (2.0e0,3.0e0),
230  + (2.0e0,3.0e0), (2.0e0,3.0e0), (2.0e0,3.0e0)/
231  DATA ((ctrue6(i,j,2),i=1,8),j=1,5)/(0.1e0,0.1e0),
232  + (4.0e0,5.0e0), (4.0e0,5.0e0), (4.0e0,5.0e0),
233  + (4.0e0,5.0e0), (4.0e0,5.0e0), (4.0e0,5.0e0),
234  + (4.0e0,5.0e0), (0.09e0,-0.12e0), (6.0e0,7.0e0),
235  + (6.0e0,7.0e0), (6.0e0,7.0e0), (6.0e0,7.0e0),
236  + (6.0e0,7.0e0), (6.0e0,7.0e0), (6.0e0,7.0e0),
237  + (0.03e0,-0.09e0), (8.0e0,9.0e0),
238  + (0.15e0,-0.03e0), (2.0e0,5.0e0), (2.0e0,5.0e0),
239  + (2.0e0,5.0e0), (2.0e0,5.0e0), (2.0e0,5.0e0),
240  + (0.03e0,0.03e0), (3.0e0,6.0e0),
241  + (-0.18e0,0.03e0), (4.0e0,7.0e0),
242  + (0.03e0,-0.09e0), (7.0e0,2.0e0), (7.0e0,2.0e0),
243  + (7.0e0,2.0e0), (0.09e0,0.03e0), (5.0e0,8.0e0),
244  + (0.15e0,0.00e0), (6.0e0,9.0e0), (0.00e0,0.15e0),
245  + (8.0e0,3.0e0), (0.00e0,0.06e0), (9.0e0,4.0e0)/
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 * .. SCNRM2 ..
259  CALL stest1(scnrm2(n,cx,incx),strue2(np1),strue2(np1),
260  + sfac)
261  ELSE IF (icase.EQ.7) THEN
262 * .. SCASUM ..
263  CALL stest1(scasum(n,cx,incx),strue4(np1),strue4(np1),
264  + sfac)
265  ELSE IF (icase.EQ.8) THEN
266 * .. CSCAL ..
267  CALL cscal(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 * .. CSSCAL ..
272  CALL csscal(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 * .. ICAMAX ..
277  CALL itest1(icamax(n,cx,incx),itrue3(np1))
278  DO 160 i = 1, len
279  cx(i) = (42.0e0,43.0e0)
280  160 CONTINUE
281  CALL itest1(icamax(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(icamax(n,cxr,incx),3)
296  END IF
297  60 CONTINUE
298 *
299  incx = 1
300  IF (icase.EQ.8) THEN
301 * CSCAL
302 * Add a test for alpha equal to zero.
303  ca = (0.0e0,0.0e0)
304  DO 80 i = 1, 5
305  mwpct(i) = (0.0e0,0.0e0)
306  mwpcs(i) = (1.0e0,1.0e0)
307  80 CONTINUE
308  CALL cscal(5,ca,cx,incx)
309  CALL ctest(5,cx,mwpct,mwpcs,sfac)
310  ELSE IF (icase.EQ.9) THEN
311 * CSSCAL
312 * Add a test for alpha equal to zero.
313  sa = 0.0e0
314  DO 100 i = 1, 5
315  mwpct(i) = (0.0e0,0.0e0)
316  mwpcs(i) = (1.0e0,1.0e0)
317  100 CONTINUE
318  CALL csscal(5,sa,cx,incx)
319  CALL ctest(5,cx,mwpct,mwpcs,sfac)
320 * Add a test for alpha equal to one.
321  sa = 1.0e0
322  DO 120 i = 1, 5
323  mwpct(i) = cx(i)
324  mwpcs(i) = cx(i)
325  120 CONTINUE
326  CALL csscal(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.0e0
330  DO 140 i = 1, 5
331  mwpct(i) = -cx(i)
332  mwpcs(i) = -cx(i)
333  140 CONTINUE
334  CALL csscal(5,sa,cx,incx)
335  CALL ctest(5,cx,mwpct,mwpcs,sfac)
336  END IF
337  RETURN
338 *
339 * End of CHECK1
340 *
subroutine stest1(SCOMP1, STRUE1, SSIZE, SFAC)
Definition: cblat1.f:668
subroutine ctest(LEN, CCOMP, CTRUE, CSIZE, SFAC)
Definition: cblat1.f:709
subroutine itest1(ICOMP, ITRUE)
Definition: cblat1.f:743
integer function icamax(N, CX, INCX)
ICAMAX
Definition: icamax.f:71
subroutine csscal(N, SA, CX, INCX)
CSSCAL
Definition: csscal.f:78
subroutine cscal(N, CA, CX, INCX)
CSCAL
Definition: cscal.f:78
real function scasum(N, CX, INCX)
SCASUM
Definition: scasum.f:72
real(wp) function scnrm2(n, x, incx)
SCNRM2
Definition: scnrm2.f90:90
Here is the call graph for this function:
Here is the caller graph for this function: