LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine check1 ( real  SFAC)

Definition at line 77 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
itest1
subroutine itest1(ICOMP, ITRUE)
Definition: cblat1.f:686
cscal
subroutine cscal(N, CA, CX, INCX)
CSCAL
Definition: cscal.f:54
stest1
subroutine stest1(SCOMP1, STRUE1, SSIZE, SFAC)
Definition: cblat1.f:620
ctest
subroutine ctest(LEN, CCOMP, CTRUE, CSIZE, SFAC)
Definition: cblat1.f:655

Here is the call graph for this function: