LAPACK 3.11.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ 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*
stest1
subroutine stest1(SCOMP1, STRUE1, SSIZE, SFAC)
Definition: cblat1.f:668
ctest
subroutine ctest(LEN, CCOMP, CTRUE, CSIZE, SFAC)
Definition: cblat1.f:709
itest1
subroutine itest1(ICOMP, ITRUE)
Definition: cblat1.f:743
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
scasum
real function scasum(N, CX, INCX)
SCASUM
Definition: scasum.f:72
scnrm2
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: