LAPACK  3.9.0
LAPACK: Linear Algebra PACKage

◆ check1()

subroutine check1 ( real  SFAC)

Definition at line 119 of file cblat1.f.

119 * .. Parameters ..
120  INTEGER NOUT
121  parameter(nout=6)
122 * .. Scalar Arguments ..
123  REAL SFAC
124 * .. Scalars in Common ..
125  INTEGER ICASE, INCX, INCY, MODE, N
126  LOGICAL PASS
127 * .. Local Scalars ..
128  COMPLEX CA
129  REAL SA
130  INTEGER I, J, LEN, NP1
131 * .. Local Arrays ..
132  COMPLEX CTRUE5(8,5,2), CTRUE6(8,5,2), CV(8,5,2), CX(8),
133  + MWPCS(5), MWPCT(5)
134  REAL STRUE2(5), STRUE4(5)
135  INTEGER ITRUE3(5)
136 * .. External Functions ..
137  REAL SCASUM, SCNRM2
138  INTEGER ICAMAX
139  EXTERNAL scasum, scnrm2, icamax
140 * .. External Subroutines ..
141  EXTERNAL cscal, csscal, 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.3e0, (0.4e0,-0.7e0)/
148  DATA ((cv(i,j,1),i=1,8),j=1,5)/(0.1e0,0.1e0),
149  + (1.0e0,2.0e0), (1.0e0,2.0e0), (1.0e0,2.0e0),
150  + (1.0e0,2.0e0), (1.0e0,2.0e0), (1.0e0,2.0e0),
151  + (1.0e0,2.0e0), (0.3e0,-0.4e0), (3.0e0,4.0e0),
152  + (3.0e0,4.0e0), (3.0e0,4.0e0), (3.0e0,4.0e0),
153  + (3.0e0,4.0e0), (3.0e0,4.0e0), (3.0e0,4.0e0),
154  + (0.1e0,-0.3e0), (0.5e0,-0.1e0), (5.0e0,6.0e0),
155  + (5.0e0,6.0e0), (5.0e0,6.0e0), (5.0e0,6.0e0),
156  + (5.0e0,6.0e0), (5.0e0,6.0e0), (0.1e0,0.1e0),
157  + (-0.6e0,0.1e0), (0.1e0,-0.3e0), (7.0e0,8.0e0),
158  + (7.0e0,8.0e0), (7.0e0,8.0e0), (7.0e0,8.0e0),
159  + (7.0e0,8.0e0), (0.3e0,0.1e0), (0.5e0,0.0e0),
160  + (0.0e0,0.5e0), (0.0e0,0.2e0), (2.0e0,3.0e0),
161  + (2.0e0,3.0e0), (2.0e0,3.0e0), (2.0e0,3.0e0)/
162  DATA ((cv(i,j,2),i=1,8),j=1,5)/(0.1e0,0.1e0),
163  + (4.0e0,5.0e0), (4.0e0,5.0e0), (4.0e0,5.0e0),
164  + (4.0e0,5.0e0), (4.0e0,5.0e0), (4.0e0,5.0e0),
165  + (4.0e0,5.0e0), (0.3e0,-0.4e0), (6.0e0,7.0e0),
166  + (6.0e0,7.0e0), (6.0e0,7.0e0), (6.0e0,7.0e0),
167  + (6.0e0,7.0e0), (6.0e0,7.0e0), (6.0e0,7.0e0),
168  + (0.1e0,-0.3e0), (8.0e0,9.0e0), (0.5e0,-0.1e0),
169  + (2.0e0,5.0e0), (2.0e0,5.0e0), (2.0e0,5.0e0),
170  + (2.0e0,5.0e0), (2.0e0,5.0e0), (0.1e0,0.1e0),
171  + (3.0e0,6.0e0), (-0.6e0,0.1e0), (4.0e0,7.0e0),
172  + (0.1e0,-0.3e0), (7.0e0,2.0e0), (7.0e0,2.0e0),
173  + (7.0e0,2.0e0), (0.3e0,0.1e0), (5.0e0,8.0e0),
174  + (0.5e0,0.0e0), (6.0e0,9.0e0), (0.0e0,0.5e0),
175  + (8.0e0,3.0e0), (0.0e0,0.2e0), (9.0e0,4.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 * .. 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 * .. SCNRM2 ..
252  CALL stest1(scnrm2(n,cx,incx),strue2(np1),strue2(np1),
253  + sfac)
254  ELSE IF (icase.EQ.7) THEN
255 * .. SCASUM ..
256  CALL stest1(scasum(n,cx,incx),strue4(np1),strue4(np1),
257  + sfac)
258  ELSE IF (icase.EQ.8) THEN
259 * .. CSCAL ..
260  CALL cscal(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 * .. CSSCAL ..
265  CALL csscal(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 * .. ICAMAX ..
270  CALL itest1(icamax(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 * CSCAL
282 * Add a test for alpha equal to zero.
283  ca = (0.0e0,0.0e0)
284  DO 80 i = 1, 5
285  mwpct(i) = (0.0e0,0.0e0)
286  mwpcs(i) = (1.0e0,1.0e0)
287  80 CONTINUE
288  CALL cscal(5,ca,cx,incx)
289  CALL ctest(5,cx,mwpct,mwpcs,sfac)
290  ELSE IF (icase.EQ.9) THEN
291 * CSSCAL
292 * Add a test for alpha equal to zero.
293  sa = 0.0e0
294  DO 100 i = 1, 5
295  mwpct(i) = (0.0e0,0.0e0)
296  mwpcs(i) = (1.0e0,1.0e0)
297  100 CONTINUE
298  CALL csscal(5,sa,cx,incx)
299  CALL ctest(5,cx,mwpct,mwpcs,sfac)
300 * Add a test for alpha equal to one.
301  sa = 1.0e0
302  DO 120 i = 1, 5
303  mwpct(i) = cx(i)
304  mwpcs(i) = cx(i)
305  120 CONTINUE
306  CALL csscal(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.0e0
310  DO 140 i = 1, 5
311  mwpct(i) = -cx(i)
312  mwpcs(i) = -cx(i)
313  140 CONTINUE
314  CALL csscal(5,sa,cx,incx)
315  CALL ctest(5,cx,mwpct,mwpcs,sfac)
316  END IF
317  RETURN
Here is the call graph for this function:
Here is the caller graph for this function:
ctest
subroutine ctest(LEN, CCOMP, CTRUE, CSIZE, SFAC)
Definition: cblat1.f:655
csscal
subroutine csscal(N, SA, CX, INCX)
CSSCAL
Definition: csscal.f:80
scnrm2
real function scnrm2(N, X, INCX)
SCNRM2
Definition: scnrm2.f:77
stest1
subroutine stest1(SCOMP1, STRUE1, SSIZE, SFAC)
Definition: cblat1.f:620
cscal
subroutine cscal(N, CA, CX, INCX)
CSCAL
Definition: cscal.f:80
itest1
subroutine itest1(ICOMP, ITRUE)
Definition: cblat1.f:686
scasum
real function scasum(N, CX, INCX)
SCASUM
Definition: scasum.f:74
icamax
integer function icamax(N, CX, INCX)
ICAMAX
Definition: icamax.f:73