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

◆ check1()

subroutine check1 ( real sfac)

Definition at line 76 of file c_cblat1.f.

77* .. Parameters ..
78 INTEGER NOUT
79 parameter(nout=6)
80* .. Scalar Arguments ..
81 REAL SFAC
82* .. Scalars in Common ..
83 INTEGER ICASE, INCX, INCY, MODE, N
84 LOGICAL PASS
85* .. Local Scalars ..
86 COMPLEX CA
87 REAL SA
88 INTEGER I, J, LEN, NP1
89* .. Local Arrays ..
90 COMPLEX CTRUE5(8,5,2), CTRUE6(8,5,2), CV(8,5,2), CX(8),
91 + MWPCS(5), MWPCT(5)
92 REAL STRUE2(5), STRUE4(5)
93 INTEGER ITRUE3(5)
94* .. External Functions ..
95 REAL SCASUMTEST, SCNRM2TEST
96 INTEGER ICAMAXTEST
97 EXTERNAL scasumtest, scnrm2test, icamaxtest
98* .. External Subroutines ..
99 EXTERNAL cscal, csscaltest, ctest, itest1, stest1
100* .. Intrinsic Functions ..
101 INTRINSIC max
102* .. Common blocks ..
103 COMMON /combla/icase, n, incx, incy, mode, pass
104* .. Data statements ..
105 DATA sa, ca/0.3e0, (0.4e0,-0.7e0)/
106 DATA ((cv(i,j,1),i=1,8),j=1,5)/(0.1e0,0.1e0),
107 + (1.0e0,2.0e0), (1.0e0,2.0e0), (1.0e0,2.0e0),
108 + (1.0e0,2.0e0), (1.0e0,2.0e0), (1.0e0,2.0e0),
109 + (1.0e0,2.0e0), (0.3e0,-0.4e0), (3.0e0,4.0e0),
110 + (3.0e0,4.0e0), (3.0e0,4.0e0), (3.0e0,4.0e0),
111 + (3.0e0,4.0e0), (3.0e0,4.0e0), (3.0e0,4.0e0),
112 + (0.1e0,-0.3e0), (0.5e0,-0.1e0), (5.0e0,6.0e0),
113 + (5.0e0,6.0e0), (5.0e0,6.0e0), (5.0e0,6.0e0),
114 + (5.0e0,6.0e0), (5.0e0,6.0e0), (0.1e0,0.1e0),
115 + (-0.6e0,0.1e0), (0.1e0,-0.3e0), (7.0e0,8.0e0),
116 + (7.0e0,8.0e0), (7.0e0,8.0e0), (7.0e0,8.0e0),
117 + (7.0e0,8.0e0), (0.3e0,0.1e0), (0.1e0,0.4e0),
118 + (0.4e0,0.1e0), (0.1e0,0.2e0), (2.0e0,3.0e0),
119 + (2.0e0,3.0e0), (2.0e0,3.0e0), (2.0e0,3.0e0)/
120 DATA ((cv(i,j,2),i=1,8),j=1,5)/(0.1e0,0.1e0),
121 + (4.0e0,5.0e0), (4.0e0,5.0e0), (4.0e0,5.0e0),
122 + (4.0e0,5.0e0), (4.0e0,5.0e0), (4.0e0,5.0e0),
123 + (4.0e0,5.0e0), (0.3e0,-0.4e0), (6.0e0,7.0e0),
124 + (6.0e0,7.0e0), (6.0e0,7.0e0), (6.0e0,7.0e0),
125 + (6.0e0,7.0e0), (6.0e0,7.0e0), (6.0e0,7.0e0),
126 + (0.1e0,-0.3e0), (8.0e0,9.0e0), (0.5e0,-0.1e0),
127 + (2.0e0,5.0e0), (2.0e0,5.0e0), (2.0e0,5.0e0),
128 + (2.0e0,5.0e0), (2.0e0,5.0e0), (0.1e0,0.1e0),
129 + (3.0e0,6.0e0), (-0.6e0,0.1e0), (4.0e0,7.0e0),
130 + (0.1e0,-0.3e0), (7.0e0,2.0e0), (7.0e0,2.0e0),
131 + (7.0e0,2.0e0), (0.3e0,0.1e0), (5.0e0,8.0e0),
132 + (0.1e0,0.4e0), (6.0e0,9.0e0), (0.4e0,0.1e0),
133 + (8.0e0,3.0e0), (0.1e0,0.2e0), (9.0e0,4.0e0)/
134 DATA strue2/0.0e0, 0.5e0, 0.6e0, 0.7e0, 0.7e0/
135 DATA strue4/0.0e0, 0.7e0, 1.0e0, 1.3e0, 1.7e0/
136 DATA ((ctrue5(i,j,1),i=1,8),j=1,5)/(0.1e0,0.1e0),
137 + (1.0e0,2.0e0), (1.0e0,2.0e0), (1.0e0,2.0e0),
138 + (1.0e0,2.0e0), (1.0e0,2.0e0), (1.0e0,2.0e0),
139 + (1.0e0,2.0e0), (-0.16e0,-0.37e0), (3.0e0,4.0e0),
140 + (3.0e0,4.0e0), (3.0e0,4.0e0), (3.0e0,4.0e0),
141 + (3.0e0,4.0e0), (3.0e0,4.0e0), (3.0e0,4.0e0),
142 + (-0.17e0,-0.19e0), (0.13e0,-0.39e0),
143 + (5.0e0,6.0e0), (5.0e0,6.0e0), (5.0e0,6.0e0),
144 + (5.0e0,6.0e0), (5.0e0,6.0e0), (5.0e0,6.0e0),
145 + (0.11e0,-0.03e0), (-0.17e0,0.46e0),
146 + (-0.17e0,-0.19e0), (7.0e0,8.0e0), (7.0e0,8.0e0),
147 + (7.0e0,8.0e0), (7.0e0,8.0e0), (7.0e0,8.0e0),
148 + (0.19e0,-0.17e0), (0.32e0,0.09e0),
149 + (0.23e0,-0.24e0), (0.18e0,0.01e0),
150 + (2.0e0,3.0e0), (2.0e0,3.0e0), (2.0e0,3.0e0),
151 + (2.0e0,3.0e0)/
152 DATA ((ctrue5(i,j,2),i=1,8),j=1,5)/(0.1e0,0.1e0),
153 + (4.0e0,5.0e0), (4.0e0,5.0e0), (4.0e0,5.0e0),
154 + (4.0e0,5.0e0), (4.0e0,5.0e0), (4.0e0,5.0e0),
155 + (4.0e0,5.0e0), (-0.16e0,-0.37e0), (6.0e0,7.0e0),
156 + (6.0e0,7.0e0), (6.0e0,7.0e0), (6.0e0,7.0e0),
157 + (6.0e0,7.0e0), (6.0e0,7.0e0), (6.0e0,7.0e0),
158 + (-0.17e0,-0.19e0), (8.0e0,9.0e0),
159 + (0.13e0,-0.39e0), (2.0e0,5.0e0), (2.0e0,5.0e0),
160 + (2.0e0,5.0e0), (2.0e0,5.0e0), (2.0e0,5.0e0),
161 + (0.11e0,-0.03e0), (3.0e0,6.0e0),
162 + (-0.17e0,0.46e0), (4.0e0,7.0e0),
163 + (-0.17e0,-0.19e0), (7.0e0,2.0e0), (7.0e0,2.0e0),
164 + (7.0e0,2.0e0), (0.19e0,-0.17e0), (5.0e0,8.0e0),
165 + (0.32e0,0.09e0), (6.0e0,9.0e0),
166 + (0.23e0,-0.24e0), (8.0e0,3.0e0),
167 + (0.18e0,0.01e0), (9.0e0,4.0e0)/
168 DATA ((ctrue6(i,j,1),i=1,8),j=1,5)/(0.1e0,0.1e0),
169 + (1.0e0,2.0e0), (1.0e0,2.0e0), (1.0e0,2.0e0),
170 + (1.0e0,2.0e0), (1.0e0,2.0e0), (1.0e0,2.0e0),
171 + (1.0e0,2.0e0), (0.09e0,-0.12e0), (3.0e0,4.0e0),
172 + (3.0e0,4.0e0), (3.0e0,4.0e0), (3.0e0,4.0e0),
173 + (3.0e0,4.0e0), (3.0e0,4.0e0), (3.0e0,4.0e0),
174 + (0.03e0,-0.09e0), (0.15e0,-0.03e0),
175 + (5.0e0,6.0e0), (5.0e0,6.0e0), (5.0e0,6.0e0),
176 + (5.0e0,6.0e0), (5.0e0,6.0e0), (5.0e0,6.0e0),
177 + (0.03e0,0.03e0), (-0.18e0,0.03e0),
178 + (0.03e0,-0.09e0), (7.0e0,8.0e0), (7.0e0,8.0e0),
179 + (7.0e0,8.0e0), (7.0e0,8.0e0), (7.0e0,8.0e0),
180 + (0.09e0,0.03e0), (0.03e0,0.12e0),
181 + (0.12e0,0.03e0), (0.03e0,0.06e0), (2.0e0,3.0e0),
182 + (2.0e0,3.0e0), (2.0e0,3.0e0), (2.0e0,3.0e0)/
183 DATA ((ctrue6(i,j,2),i=1,8),j=1,5)/(0.1e0,0.1e0),
184 + (4.0e0,5.0e0), (4.0e0,5.0e0), (4.0e0,5.0e0),
185 + (4.0e0,5.0e0), (4.0e0,5.0e0), (4.0e0,5.0e0),
186 + (4.0e0,5.0e0), (0.09e0,-0.12e0), (6.0e0,7.0e0),
187 + (6.0e0,7.0e0), (6.0e0,7.0e0), (6.0e0,7.0e0),
188 + (6.0e0,7.0e0), (6.0e0,7.0e0), (6.0e0,7.0e0),
189 + (0.03e0,-0.09e0), (8.0e0,9.0e0),
190 + (0.15e0,-0.03e0), (2.0e0,5.0e0), (2.0e0,5.0e0),
191 + (2.0e0,5.0e0), (2.0e0,5.0e0), (2.0e0,5.0e0),
192 + (0.03e0,0.03e0), (3.0e0,6.0e0),
193 + (-0.18e0,0.03e0), (4.0e0,7.0e0),
194 + (0.03e0,-0.09e0), (7.0e0,2.0e0), (7.0e0,2.0e0),
195 + (7.0e0,2.0e0), (0.09e0,0.03e0), (5.0e0,8.0e0),
196 + (0.03e0,0.12e0), (6.0e0,9.0e0), (0.12e0,0.03e0),
197 + (8.0e0,3.0e0), (0.03e0,0.06e0), (9.0e0,4.0e0)/
198 DATA itrue3/0, 1, 2, 2, 2/
199* .. Executable Statements ..
200 DO 60 incx = 1, 2
201 DO 40 np1 = 1, 5
202 n = np1 - 1
203 len = 2*max(n,1)
204* .. Set vector arguments ..
205 DO 20 i = 1, len
206 cx(i) = cv(i,np1,incx)
207 20 CONTINUE
208 IF (icase.EQ.6) THEN
209* .. SCNRM2TEST ..
210 CALL stest1(scnrm2test(n,cx,incx),strue2(np1),
211 + strue2(np1), sfac)
212 ELSE IF (icase.EQ.7) THEN
213* .. SCASUMTEST ..
214 CALL stest1(scasumtest(n,cx,incx),strue4(np1),
215 + strue4(np1),sfac)
216 ELSE IF (icase.EQ.8) THEN
217* .. CSCAL ..
218 CALL cscal(n,ca,cx,incx)
219 CALL ctest(len,cx,ctrue5(1,np1,incx),ctrue5(1,np1,incx),
220 + sfac)
221 ELSE IF (icase.EQ.9) THEN
222* .. CSSCALTEST ..
223 CALL csscaltest(n,sa,cx,incx)
224 CALL ctest(len,cx,ctrue6(1,np1,incx),ctrue6(1,np1,incx),
225 + sfac)
226 ELSE IF (icase.EQ.10) THEN
227* .. ICAMAXTEST ..
228 CALL itest1(icamaxtest(n,cx,incx),itrue3(np1))
229 ELSE
230 WRITE (nout,*) ' Shouldn''t be here in CHECK1'
231 stop
232 END IF
233*
234 40 CONTINUE
235 60 CONTINUE
236*
237 incx = 1
238 IF (icase.EQ.8) THEN
239* CSCAL
240* Add a test for alpha equal to zero.
241 ca = (0.0e0,0.0e0)
242 DO 80 i = 1, 5
243 mwpct(i) = (0.0e0,0.0e0)
244 mwpcs(i) = (1.0e0,1.0e0)
245 80 CONTINUE
246 CALL cscal(5,ca,cx,incx)
247 CALL ctest(5,cx,mwpct,mwpcs,sfac)
248 ELSE IF (icase.EQ.9) THEN
249* CSSCALTEST
250* Add a test for alpha equal to zero.
251 sa = 0.0e0
252 DO 100 i = 1, 5
253 mwpct(i) = (0.0e0,0.0e0)
254 mwpcs(i) = (1.0e0,1.0e0)
255 100 CONTINUE
256 CALL csscaltest(5,sa,cx,incx)
257 CALL ctest(5,cx,mwpct,mwpcs,sfac)
258* Add a test for alpha equal to one.
259 sa = 1.0e0
260 DO 120 i = 1, 5
261 mwpct(i) = cx(i)
262 mwpcs(i) = cx(i)
263 120 CONTINUE
264 CALL csscaltest(5,sa,cx,incx)
265 CALL ctest(5,cx,mwpct,mwpcs,sfac)
266* Add a test for alpha equal to minus one.
267 sa = -1.0e0
268 DO 140 i = 1, 5
269 mwpct(i) = -cx(i)
270 mwpcs(i) = -cx(i)
271 140 CONTINUE
272 CALL csscaltest(5,sa,cx,incx)
273 CALL ctest(5,cx,mwpct,mwpcs,sfac)
274 END IF
275 RETURN
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
cscal
subroutine cscal(n, ca, cx, incx)
CSCAL
Definition cscal.f:78
Here is the call graph for this function: