LAPACK  3.9.1
LAPACK: Linear Algebra PACKage

◆ check1()

subroutine check1 ( real  SFAC)

Definition at line 115 of file cblat1.f.

116 * .. Parameters ..
117  INTEGER NOUT
118  parameter(nout=6)
119 * .. Scalar Arguments ..
120  REAL SFAC
121 * .. Scalars in Common ..
122  INTEGER ICASE, INCX, INCY, MODE, N
123  LOGICAL PASS
124 * .. Local Scalars ..
125  COMPLEX CA
126  REAL SA
127  INTEGER I, IX, J, LEN, NP1
128 * .. Local Arrays ..
129  COMPLEX CTRUE5(8,5,2), CTRUE6(8,5,2), CV(8,5,2), CVR(8),
130  + CX(8), CXR(15), MWPCS(5), MWPCT(5)
131  REAL STRUE2(5), STRUE4(5)
132  INTEGER ITRUE3(5), ITRUEC(5)
133 * .. External Functions ..
134  REAL SCASUM, SCNRM2
135  INTEGER ICAMAX
136  EXTERNAL scasum, scnrm2, icamax
137 * .. External Subroutines ..
138  EXTERNAL cscal, csscal, 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.3e0, (0.4e0,-0.7e0)/
145  DATA ((cv(i,j,1),i=1,8),j=1,5)/(0.1e0,0.1e0),
146  + (1.0e0,2.0e0), (1.0e0,2.0e0), (1.0e0,2.0e0),
147  + (1.0e0,2.0e0), (1.0e0,2.0e0), (1.0e0,2.0e0),
148  + (1.0e0,2.0e0), (0.3e0,-0.4e0), (3.0e0,4.0e0),
149  + (3.0e0,4.0e0), (3.0e0,4.0e0), (3.0e0,4.0e0),
150  + (3.0e0,4.0e0), (3.0e0,4.0e0), (3.0e0,4.0e0),
151  + (0.1e0,-0.3e0), (0.5e0,-0.1e0), (5.0e0,6.0e0),
152  + (5.0e0,6.0e0), (5.0e0,6.0e0), (5.0e0,6.0e0),
153  + (5.0e0,6.0e0), (5.0e0,6.0e0), (0.1e0,0.1e0),
154  + (-0.6e0,0.1e0), (0.1e0,-0.3e0), (7.0e0,8.0e0),
155  + (7.0e0,8.0e0), (7.0e0,8.0e0), (7.0e0,8.0e0),
156  + (7.0e0,8.0e0), (0.3e0,0.1e0), (0.5e0,0.0e0),
157  + (0.0e0,0.5e0), (0.0e0,0.2e0), (2.0e0,3.0e0),
158  + (2.0e0,3.0e0), (2.0e0,3.0e0), (2.0e0,3.0e0)/
159  DATA ((cv(i,j,2),i=1,8),j=1,5)/(0.1e0,0.1e0),
160  + (4.0e0,5.0e0), (4.0e0,5.0e0), (4.0e0,5.0e0),
161  + (4.0e0,5.0e0), (4.0e0,5.0e0), (4.0e0,5.0e0),
162  + (4.0e0,5.0e0), (0.3e0,-0.4e0), (6.0e0,7.0e0),
163  + (6.0e0,7.0e0), (6.0e0,7.0e0), (6.0e0,7.0e0),
164  + (6.0e0,7.0e0), (6.0e0,7.0e0), (6.0e0,7.0e0),
165  + (0.1e0,-0.3e0), (8.0e0,9.0e0), (0.5e0,-0.1e0),
166  + (2.0e0,5.0e0), (2.0e0,5.0e0), (2.0e0,5.0e0),
167  + (2.0e0,5.0e0), (2.0e0,5.0e0), (0.1e0,0.1e0),
168  + (3.0e0,6.0e0), (-0.6e0,0.1e0), (4.0e0,7.0e0),
169  + (0.1e0,-0.3e0), (7.0e0,2.0e0), (7.0e0,2.0e0),
170  + (7.0e0,2.0e0), (0.3e0,0.1e0), (5.0e0,8.0e0),
171  + (0.5e0,0.0e0), (6.0e0,9.0e0), (0.0e0,0.5e0),
172  + (8.0e0,3.0e0), (0.0e0,0.2e0), (9.0e0,4.0e0)/
173  DATA cvr/(8.0e0,8.0e0), (-7.0e0,-7.0e0),
174  + (9.0e0,9.0e0), (5.0e0,5.0e0), (9.0e0,9.0e0),
175  + (8.0e0,8.0e0), (7.0e0,7.0e0), (7.0e0,7.0e0)/
176  DATA strue2/0.0e0, 0.5e0, 0.6e0, 0.7e0, 0.8e0/
177  DATA strue4/0.0e0, 0.7e0, 1.0e0, 1.3e0, 1.6e0/
178  DATA ((ctrue5(i,j,1),i=1,8),j=1,5)/(0.1e0,0.1e0),
179  + (1.0e0,2.0e0), (1.0e0,2.0e0), (1.0e0,2.0e0),
180  + (1.0e0,2.0e0), (1.0e0,2.0e0), (1.0e0,2.0e0),
181  + (1.0e0,2.0e0), (-0.16e0,-0.37e0), (3.0e0,4.0e0),
182  + (3.0e0,4.0e0), (3.0e0,4.0e0), (3.0e0,4.0e0),
183  + (3.0e0,4.0e0), (3.0e0,4.0e0), (3.0e0,4.0e0),
184  + (-0.17e0,-0.19e0), (0.13e0,-0.39e0),
185  + (5.0e0,6.0e0), (5.0e0,6.0e0), (5.0e0,6.0e0),
186  + (5.0e0,6.0e0), (5.0e0,6.0e0), (5.0e0,6.0e0),
187  + (0.11e0,-0.03e0), (-0.17e0,0.46e0),
188  + (-0.17e0,-0.19e0), (7.0e0,8.0e0), (7.0e0,8.0e0),
189  + (7.0e0,8.0e0), (7.0e0,8.0e0), (7.0e0,8.0e0),
190  + (0.19e0,-0.17e0), (0.20e0,-0.35e0),
191  + (0.35e0,0.20e0), (0.14e0,0.08e0),
192  + (2.0e0,3.0e0), (2.0e0,3.0e0), (2.0e0,3.0e0),
193  + (2.0e0,3.0e0)/
194  DATA ((ctrue5(i,j,2),i=1,8),j=1,5)/(0.1e0,0.1e0),
195  + (4.0e0,5.0e0), (4.0e0,5.0e0), (4.0e0,5.0e0),
196  + (4.0e0,5.0e0), (4.0e0,5.0e0), (4.0e0,5.0e0),
197  + (4.0e0,5.0e0), (-0.16e0,-0.37e0), (6.0e0,7.0e0),
198  + (6.0e0,7.0e0), (6.0e0,7.0e0), (6.0e0,7.0e0),
199  + (6.0e0,7.0e0), (6.0e0,7.0e0), (6.0e0,7.0e0),
200  + (-0.17e0,-0.19e0), (8.0e0,9.0e0),
201  + (0.13e0,-0.39e0), (2.0e0,5.0e0), (2.0e0,5.0e0),
202  + (2.0e0,5.0e0), (2.0e0,5.0e0), (2.0e0,5.0e0),
203  + (0.11e0,-0.03e0), (3.0e0,6.0e0),
204  + (-0.17e0,0.46e0), (4.0e0,7.0e0),
205  + (-0.17e0,-0.19e0), (7.0e0,2.0e0), (7.0e0,2.0e0),
206  + (7.0e0,2.0e0), (0.19e0,-0.17e0), (5.0e0,8.0e0),
207  + (0.20e0,-0.35e0), (6.0e0,9.0e0),
208  + (0.35e0,0.20e0), (8.0e0,3.0e0),
209  + (0.14e0,0.08e0), (9.0e0,4.0e0)/
210  DATA ((ctrue6(i,j,1),i=1,8),j=1,5)/(0.1e0,0.1e0),
211  + (1.0e0,2.0e0), (1.0e0,2.0e0), (1.0e0,2.0e0),
212  + (1.0e0,2.0e0), (1.0e0,2.0e0), (1.0e0,2.0e0),
213  + (1.0e0,2.0e0), (0.09e0,-0.12e0), (3.0e0,4.0e0),
214  + (3.0e0,4.0e0), (3.0e0,4.0e0), (3.0e0,4.0e0),
215  + (3.0e0,4.0e0), (3.0e0,4.0e0), (3.0e0,4.0e0),
216  + (0.03e0,-0.09e0), (0.15e0,-0.03e0),
217  + (5.0e0,6.0e0), (5.0e0,6.0e0), (5.0e0,6.0e0),
218  + (5.0e0,6.0e0), (5.0e0,6.0e0), (5.0e0,6.0e0),
219  + (0.03e0,0.03e0), (-0.18e0,0.03e0),
220  + (0.03e0,-0.09e0), (7.0e0,8.0e0), (7.0e0,8.0e0),
221  + (7.0e0,8.0e0), (7.0e0,8.0e0), (7.0e0,8.0e0),
222  + (0.09e0,0.03e0), (0.15e0,0.00e0),
223  + (0.00e0,0.15e0), (0.00e0,0.06e0), (2.0e0,3.0e0),
224  + (2.0e0,3.0e0), (2.0e0,3.0e0), (2.0e0,3.0e0)/
225  DATA ((ctrue6(i,j,2),i=1,8),j=1,5)/(0.1e0,0.1e0),
226  + (4.0e0,5.0e0), (4.0e0,5.0e0), (4.0e0,5.0e0),
227  + (4.0e0,5.0e0), (4.0e0,5.0e0), (4.0e0,5.0e0),
228  + (4.0e0,5.0e0), (0.09e0,-0.12e0), (6.0e0,7.0e0),
229  + (6.0e0,7.0e0), (6.0e0,7.0e0), (6.0e0,7.0e0),
230  + (6.0e0,7.0e0), (6.0e0,7.0e0), (6.0e0,7.0e0),
231  + (0.03e0,-0.09e0), (8.0e0,9.0e0),
232  + (0.15e0,-0.03e0), (2.0e0,5.0e0), (2.0e0,5.0e0),
233  + (2.0e0,5.0e0), (2.0e0,5.0e0), (2.0e0,5.0e0),
234  + (0.03e0,0.03e0), (3.0e0,6.0e0),
235  + (-0.18e0,0.03e0), (4.0e0,7.0e0),
236  + (0.03e0,-0.09e0), (7.0e0,2.0e0), (7.0e0,2.0e0),
237  + (7.0e0,2.0e0), (0.09e0,0.03e0), (5.0e0,8.0e0),
238  + (0.15e0,0.00e0), (6.0e0,9.0e0), (0.00e0,0.15e0),
239  + (8.0e0,3.0e0), (0.00e0,0.06e0), (9.0e0,4.0e0)/
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 * .. SCNRM2 ..
253  CALL stest1(scnrm2(n,cx,incx),strue2(np1),strue2(np1),
254  + sfac)
255  ELSE IF (icase.EQ.7) THEN
256 * .. SCASUM ..
257  CALL stest1(scasum(n,cx,incx),strue4(np1),strue4(np1),
258  + sfac)
259  ELSE IF (icase.EQ.8) THEN
260 * .. CSCAL ..
261  CALL cscal(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 * .. CSSCAL ..
266  CALL csscal(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 * .. ICAMAX ..
271  CALL itest1(icamax(n,cx,incx),itrue3(np1))
272  DO 160 i = 1, len
273  cx(i) = (42.0e0,43.0e0)
274  160 CONTINUE
275  CALL itest1(icamax(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(icamax(n,cxr,incx),3)
290  END IF
291  60 CONTINUE
292 *
293  incx = 1
294  IF (icase.EQ.8) THEN
295 * CSCAL
296 * Add a test for alpha equal to zero.
297  ca = (0.0e0,0.0e0)
298  DO 80 i = 1, 5
299  mwpct(i) = (0.0e0,0.0e0)
300  mwpcs(i) = (1.0e0,1.0e0)
301  80 CONTINUE
302  CALL cscal(5,ca,cx,incx)
303  CALL ctest(5,cx,mwpct,mwpcs,sfac)
304  ELSE IF (icase.EQ.9) THEN
305 * CSSCAL
306 * Add a test for alpha equal to zero.
307  sa = 0.0e0
308  DO 100 i = 1, 5
309  mwpct(i) = (0.0e0,0.0e0)
310  mwpcs(i) = (1.0e0,1.0e0)
311  100 CONTINUE
312  CALL csscal(5,sa,cx,incx)
313  CALL ctest(5,cx,mwpct,mwpcs,sfac)
314 * Add a test for alpha equal to one.
315  sa = 1.0e0
316  DO 120 i = 1, 5
317  mwpct(i) = cx(i)
318  mwpcs(i) = cx(i)
319  120 CONTINUE
320  CALL csscal(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.0e0
324  DO 140 i = 1, 5
325  mwpct(i) = -cx(i)
326  mwpcs(i) = -cx(i)
327  140 CONTINUE
328  CALL csscal(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
icamax
integer function icamax(N, CX, INCX)
ICAMAX
Definition: icamax.f:71
csscal
subroutine csscal(N, SA, CX, INCX)
CSSCAL
Definition: csscal.f:78
cscal
subroutine cscal(N, CA, CX, INCX)
CSCAL
Definition: cscal.f:78
scnrm2
real function scnrm2(N, X, INCX)
SCNRM2
Definition: scnrm2.f:75
scasum
real function scasum(N, CX, INCX)
SCASUM
Definition: scasum.f:72
Here is the call graph for this function:
Here is the caller graph for this function: