LAPACK 3.12.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 REAL THRESH
125 parameter(nout=6, thresh=10.0e0)
126* .. Scalar Arguments ..
127 REAL SFAC
128* .. Scalars in Common ..
129 INTEGER ICASE, INCX, INCY, MODE, N
130 LOGICAL PASS
131* .. Local Scalars ..
132 COMPLEX CA
133 REAL SA
134 INTEGER I, IX, J, LEN, NP1
135* .. Local Arrays ..
136 COMPLEX CTRUE5(8,5,2), CTRUE6(8,5,2), CV(8,5,2), CVR(8),
137 + CX(8), CXR(15), MWPCS(5), MWPCT(5)
138 REAL STRUE2(5), STRUE4(5)
139 INTEGER ITRUE3(5), ITRUEC(5)
140* .. External Functions ..
141 REAL SCASUM, SCNRM2
142 INTEGER ICAMAX
143 EXTERNAL scasum, scnrm2, icamax
144* .. External Subroutines ..
145 EXTERNAL cb1nrm2, cscal, csscal, ctest, itest1, stest1
146* .. Intrinsic Functions ..
147 INTRINSIC max
148* .. Common blocks ..
149 COMMON /combla/icase, n, incx, incy, mode, pass
150* .. Data statements ..
151 DATA sa, ca/0.3e0, (0.4e0,-0.7e0)/
152 DATA ((cv(i,j,1),i=1,8),j=1,5)/(0.1e0,0.1e0),
153 + (1.0e0,2.0e0), (1.0e0,2.0e0), (1.0e0,2.0e0),
154 + (1.0e0,2.0e0), (1.0e0,2.0e0), (1.0e0,2.0e0),
155 + (1.0e0,2.0e0), (0.3e0,-0.4e0), (3.0e0,4.0e0),
156 + (3.0e0,4.0e0), (3.0e0,4.0e0), (3.0e0,4.0e0),
157 + (3.0e0,4.0e0), (3.0e0,4.0e0), (3.0e0,4.0e0),
158 + (0.1e0,-0.3e0), (0.5e0,-0.1e0), (5.0e0,6.0e0),
159 + (5.0e0,6.0e0), (5.0e0,6.0e0), (5.0e0,6.0e0),
160 + (5.0e0,6.0e0), (5.0e0,6.0e0), (0.1e0,0.1e0),
161 + (-0.6e0,0.1e0), (0.1e0,-0.3e0), (7.0e0,8.0e0),
162 + (7.0e0,8.0e0), (7.0e0,8.0e0), (7.0e0,8.0e0),
163 + (7.0e0,8.0e0), (0.3e0,0.1e0), (0.5e0,0.0e0),
164 + (0.0e0,0.5e0), (0.0e0,0.2e0), (2.0e0,3.0e0),
165 + (2.0e0,3.0e0), (2.0e0,3.0e0), (2.0e0,3.0e0)/
166 DATA ((cv(i,j,2),i=1,8),j=1,5)/(0.1e0,0.1e0),
167 + (4.0e0,5.0e0), (4.0e0,5.0e0), (4.0e0,5.0e0),
168 + (4.0e0,5.0e0), (4.0e0,5.0e0), (4.0e0,5.0e0),
169 + (4.0e0,5.0e0), (0.3e0,-0.4e0), (6.0e0,7.0e0),
170 + (6.0e0,7.0e0), (6.0e0,7.0e0), (6.0e0,7.0e0),
171 + (6.0e0,7.0e0), (6.0e0,7.0e0), (6.0e0,7.0e0),
172 + (0.1e0,-0.3e0), (8.0e0,9.0e0), (0.5e0,-0.1e0),
173 + (2.0e0,5.0e0), (2.0e0,5.0e0), (2.0e0,5.0e0),
174 + (2.0e0,5.0e0), (2.0e0,5.0e0), (0.1e0,0.1e0),
175 + (3.0e0,6.0e0), (-0.6e0,0.1e0), (4.0e0,7.0e0),
176 + (0.1e0,-0.3e0), (7.0e0,2.0e0), (7.0e0,2.0e0),
177 + (7.0e0,2.0e0), (0.3e0,0.1e0), (5.0e0,8.0e0),
178 + (0.5e0,0.0e0), (6.0e0,9.0e0), (0.0e0,0.5e0),
179 + (8.0e0,3.0e0), (0.0e0,0.2e0), (9.0e0,4.0e0)/
180 DATA cvr/(8.0e0,8.0e0), (-7.0e0,-7.0e0),
181 + (9.0e0,9.0e0), (5.0e0,5.0e0), (9.0e0,9.0e0),
182 + (8.0e0,8.0e0), (7.0e0,7.0e0), (7.0e0,7.0e0)/
183 DATA strue2/0.0e0, 0.5e0, 0.6e0, 0.7e0, 0.8e0/
184 DATA strue4/0.0e0, 0.7e0, 1.0e0, 1.3e0, 1.6e0/
185 DATA ((ctrue5(i,j,1),i=1,8),j=1,5)/(0.1e0,0.1e0),
186 + (1.0e0,2.0e0), (1.0e0,2.0e0), (1.0e0,2.0e0),
187 + (1.0e0,2.0e0), (1.0e0,2.0e0), (1.0e0,2.0e0),
188 + (1.0e0,2.0e0), (-0.16e0,-0.37e0), (3.0e0,4.0e0),
189 + (3.0e0,4.0e0), (3.0e0,4.0e0), (3.0e0,4.0e0),
190 + (3.0e0,4.0e0), (3.0e0,4.0e0), (3.0e0,4.0e0),
191 + (-0.17e0,-0.19e0), (0.13e0,-0.39e0),
192 + (5.0e0,6.0e0), (5.0e0,6.0e0), (5.0e0,6.0e0),
193 + (5.0e0,6.0e0), (5.0e0,6.0e0), (5.0e0,6.0e0),
194 + (0.11e0,-0.03e0), (-0.17e0,0.46e0),
195 + (-0.17e0,-0.19e0), (7.0e0,8.0e0), (7.0e0,8.0e0),
196 + (7.0e0,8.0e0), (7.0e0,8.0e0), (7.0e0,8.0e0),
197 + (0.19e0,-0.17e0), (0.20e0,-0.35e0),
198 + (0.35e0,0.20e0), (0.14e0,0.08e0),
199 + (2.0e0,3.0e0), (2.0e0,3.0e0), (2.0e0,3.0e0),
200 + (2.0e0,3.0e0)/
201 DATA ((ctrue5(i,j,2),i=1,8),j=1,5)/(0.1e0,0.1e0),
202 + (4.0e0,5.0e0), (4.0e0,5.0e0), (4.0e0,5.0e0),
203 + (4.0e0,5.0e0), (4.0e0,5.0e0), (4.0e0,5.0e0),
204 + (4.0e0,5.0e0), (-0.16e0,-0.37e0), (6.0e0,7.0e0),
205 + (6.0e0,7.0e0), (6.0e0,7.0e0), (6.0e0,7.0e0),
206 + (6.0e0,7.0e0), (6.0e0,7.0e0), (6.0e0,7.0e0),
207 + (-0.17e0,-0.19e0), (8.0e0,9.0e0),
208 + (0.13e0,-0.39e0), (2.0e0,5.0e0), (2.0e0,5.0e0),
209 + (2.0e0,5.0e0), (2.0e0,5.0e0), (2.0e0,5.0e0),
210 + (0.11e0,-0.03e0), (3.0e0,6.0e0),
211 + (-0.17e0,0.46e0), (4.0e0,7.0e0),
212 + (-0.17e0,-0.19e0), (7.0e0,2.0e0), (7.0e0,2.0e0),
213 + (7.0e0,2.0e0), (0.19e0,-0.17e0), (5.0e0,8.0e0),
214 + (0.20e0,-0.35e0), (6.0e0,9.0e0),
215 + (0.35e0,0.20e0), (8.0e0,3.0e0),
216 + (0.14e0,0.08e0), (9.0e0,4.0e0)/
217 DATA ((ctrue6(i,j,1),i=1,8),j=1,5)/(0.1e0,0.1e0),
218 + (1.0e0,2.0e0), (1.0e0,2.0e0), (1.0e0,2.0e0),
219 + (1.0e0,2.0e0), (1.0e0,2.0e0), (1.0e0,2.0e0),
220 + (1.0e0,2.0e0), (0.09e0,-0.12e0), (3.0e0,4.0e0),
221 + (3.0e0,4.0e0), (3.0e0,4.0e0), (3.0e0,4.0e0),
222 + (3.0e0,4.0e0), (3.0e0,4.0e0), (3.0e0,4.0e0),
223 + (0.03e0,-0.09e0), (0.15e0,-0.03e0),
224 + (5.0e0,6.0e0), (5.0e0,6.0e0), (5.0e0,6.0e0),
225 + (5.0e0,6.0e0), (5.0e0,6.0e0), (5.0e0,6.0e0),
226 + (0.03e0,0.03e0), (-0.18e0,0.03e0),
227 + (0.03e0,-0.09e0), (7.0e0,8.0e0), (7.0e0,8.0e0),
228 + (7.0e0,8.0e0), (7.0e0,8.0e0), (7.0e0,8.0e0),
229 + (0.09e0,0.03e0), (0.15e0,0.00e0),
230 + (0.00e0,0.15e0), (0.00e0,0.06e0), (2.0e0,3.0e0),
231 + (2.0e0,3.0e0), (2.0e0,3.0e0), (2.0e0,3.0e0)/
232 DATA ((ctrue6(i,j,2),i=1,8),j=1,5)/(0.1e0,0.1e0),
233 + (4.0e0,5.0e0), (4.0e0,5.0e0), (4.0e0,5.0e0),
234 + (4.0e0,5.0e0), (4.0e0,5.0e0), (4.0e0,5.0e0),
235 + (4.0e0,5.0e0), (0.09e0,-0.12e0), (6.0e0,7.0e0),
236 + (6.0e0,7.0e0), (6.0e0,7.0e0), (6.0e0,7.0e0),
237 + (6.0e0,7.0e0), (6.0e0,7.0e0), (6.0e0,7.0e0),
238 + (0.03e0,-0.09e0), (8.0e0,9.0e0),
239 + (0.15e0,-0.03e0), (2.0e0,5.0e0), (2.0e0,5.0e0),
240 + (2.0e0,5.0e0), (2.0e0,5.0e0), (2.0e0,5.0e0),
241 + (0.03e0,0.03e0), (3.0e0,6.0e0),
242 + (-0.18e0,0.03e0), (4.0e0,7.0e0),
243 + (0.03e0,-0.09e0), (7.0e0,2.0e0), (7.0e0,2.0e0),
244 + (7.0e0,2.0e0), (0.09e0,0.03e0), (5.0e0,8.0e0),
245 + (0.15e0,0.00e0), (6.0e0,9.0e0), (0.00e0,0.15e0),
246 + (8.0e0,3.0e0), (0.00e0,0.06e0), (9.0e0,4.0e0)/
247 DATA itrue3/0, 1, 2, 2, 2/
248 DATA itruec/0, 1, 1, 1, 1/
249* .. Executable Statements ..
250 DO 60 incx = 1, 2
251 DO 40 np1 = 1, 5
252 n = np1 - 1
253 len = 2*max(n,1)
254* .. Set vector arguments ..
255 DO 20 i = 1, len
256 cx(i) = cv(i,np1,incx)
257 20 CONTINUE
258 IF (icase.EQ.6) THEN
259* .. SCNRM2 ..
260* Test scaling when some entries are tiny or huge
261 CALL cb1nrm2(n,(incx-2)*2,thresh)
262 CALL cb1nrm2(n,incx,thresh)
263* Test with hardcoded mid range entries
264 CALL stest1(scnrm2(n,cx,incx),strue2(np1),strue2(np1),
265 + sfac)
266 ELSE IF (icase.EQ.7) THEN
267* .. SCASUM ..
268 CALL stest1(scasum(n,cx,incx),strue4(np1),strue4(np1),
269 + sfac)
270 ELSE IF (icase.EQ.8) THEN
271* .. CSCAL ..
272 CALL cscal(n,ca,cx,incx)
273 CALL ctest(len,cx,ctrue5(1,np1,incx),ctrue5(1,np1,incx),
274 + sfac)
275 ELSE IF (icase.EQ.9) THEN
276* .. CSSCAL ..
277 CALL csscal(n,sa,cx,incx)
278 CALL ctest(len,cx,ctrue6(1,np1,incx),ctrue6(1,np1,incx),
279 + sfac)
280 ELSE IF (icase.EQ.10) THEN
281* .. ICAMAX ..
282 CALL itest1(icamax(n,cx,incx),itrue3(np1))
283 DO 160 i = 1, len
284 cx(i) = (42.0e0,43.0e0)
285 160 CONTINUE
286 CALL itest1(icamax(n,cx,incx),itruec(np1))
287 ELSE
288 WRITE (nout,*) ' Shouldn''t be here in CHECK1'
289 stop
290 END IF
291*
292 40 CONTINUE
293 IF (icase.EQ.10) THEN
294 n = 8
295 ix = 1
296 DO 180 i = 1, n
297 cxr(ix) = cvr(i)
298 ix = ix + incx
299 180 CONTINUE
300 CALL itest1(icamax(n,cxr,incx),3)
301 END IF
302 60 CONTINUE
303*
304 incx = 1
305 IF (icase.EQ.8) THEN
306* CSCAL
307* Add a test for alpha equal to zero.
308 ca = (0.0e0,0.0e0)
309 DO 80 i = 1, 5
310 mwpct(i) = (0.0e0,0.0e0)
311 mwpcs(i) = (1.0e0,1.0e0)
312 80 CONTINUE
313 CALL cscal(5,ca,cx,incx)
314 CALL ctest(5,cx,mwpct,mwpcs,sfac)
315 ELSE IF (icase.EQ.9) THEN
316* CSSCAL
317* Add a test for alpha equal to zero.
318 sa = 0.0e0
319 DO 100 i = 1, 5
320 mwpct(i) = (0.0e0,0.0e0)
321 mwpcs(i) = (1.0e0,1.0e0)
322 100 CONTINUE
323 CALL csscal(5,sa,cx,incx)
324 CALL ctest(5,cx,mwpct,mwpcs,sfac)
325* Add a test for alpha equal to one.
326 sa = 1.0e0
327 DO 120 i = 1, 5
328 mwpct(i) = cx(i)
329 mwpcs(i) = cx(i)
330 120 CONTINUE
331 CALL csscal(5,sa,cx,incx)
332 CALL ctest(5,cx,mwpct,mwpcs,sfac)
333* Add a test for alpha equal to minus one.
334 sa = -1.0e0
335 DO 140 i = 1, 5
336 mwpct(i) = -cx(i)
337 mwpcs(i) = -cx(i)
338 140 CONTINUE
339 CALL csscal(5,sa,cx,incx)
340 CALL ctest(5,cx,mwpct,mwpcs,sfac)
341 END IF
342 RETURN
343*
344* End of CHECK1
345*
ctest
subroutine ctest(len, ccomp, ctrue, csize, sfac)
Definition cblat1.f:714
stest1
subroutine stest1(scomp1, strue1, ssize, sfac)
Definition cblat1.f:673
itest1
subroutine itest1(icomp, itrue)
Definition cblat1.f:748
cb1nrm2
subroutine cb1nrm2(n, incx, thresh)
Definition cblat1.f:791
scasum
real function scasum(n, cx, incx)
SCASUM
Definition scasum.f:72
icamax
integer function icamax(n, cx, incx)
ICAMAX
Definition icamax.f:71
scnrm2
real(wp) function scnrm2(n, x, incx)
SCNRM2
Definition scnrm2.f90:90
csscal
subroutine csscal(n, sa, cx, incx)
CSSCAL
Definition csscal.f:78
cscal
subroutine cscal(n, ca, cx, incx)
CSCAL
Definition cscal.f:78
Here is the call graph for this function:
Here is the caller graph for this function: