LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine check1 ( double precision  SFAC)

Definition at line 77 of file c_zblat1.f.

77 * .. Parameters ..
78  INTEGER nout
79  parameter (nout=6)
80 * .. Scalar Arguments ..
81  DOUBLE PRECISION sfac
82 * .. Scalars in Common ..
83  INTEGER icase, incx, incy, mode, n
84  LOGICAL pass
85 * .. Local Scalars ..
86  COMPLEX*16 ca
87  DOUBLE PRECISION sa
88  INTEGER i, j, len, np1
89 * .. Local Arrays ..
90  COMPLEX*16 ctrue5(8,5,2), ctrue6(8,5,2), cv(8,5,2), cx(8),
91  + mwpcs(5), mwpct(5)
92  DOUBLE PRECISION strue2(5), strue4(5)
93  INTEGER itrue3(5)
94 * .. External Functions ..
95  DOUBLE PRECISION dzasumtest, dznrm2test
96  INTEGER izamaxtest
97  EXTERNAL dzasumtest, dznrm2test, izamaxtest
98 * .. External Subroutines ..
99  EXTERNAL zscaltest, zdscaltest, 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.3d0, (0.4d0,-0.7d0)/
106  DATA ((cv(i,j,1),i=1,8),j=1,5)/(0.1d0,0.1d0),
107  + (1.0d0,2.0d0), (1.0d0,2.0d0), (1.0d0,2.0d0),
108  + (1.0d0,2.0d0), (1.0d0,2.0d0), (1.0d0,2.0d0),
109  + (1.0d0,2.0d0), (0.3d0,-0.4d0), (3.0d0,4.0d0),
110  + (3.0d0,4.0d0), (3.0d0,4.0d0), (3.0d0,4.0d0),
111  + (3.0d0,4.0d0), (3.0d0,4.0d0), (3.0d0,4.0d0),
112  + (0.1d0,-0.3d0), (0.5d0,-0.1d0), (5.0d0,6.0d0),
113  + (5.0d0,6.0d0), (5.0d0,6.0d0), (5.0d0,6.0d0),
114  + (5.0d0,6.0d0), (5.0d0,6.0d0), (0.1d0,0.1d0),
115  + (-0.6d0,0.1d0), (0.1d0,-0.3d0), (7.0d0,8.0d0),
116  + (7.0d0,8.0d0), (7.0d0,8.0d0), (7.0d0,8.0d0),
117  + (7.0d0,8.0d0), (0.3d0,0.1d0), (0.1d0,0.4d0),
118  + (0.4d0,0.1d0), (0.1d0,0.2d0), (2.0d0,3.0d0),
119  + (2.0d0,3.0d0), (2.0d0,3.0d0), (2.0d0,3.0d0)/
120  DATA ((cv(i,j,2),i=1,8),j=1,5)/(0.1d0,0.1d0),
121  + (4.0d0,5.0d0), (4.0d0,5.0d0), (4.0d0,5.0d0),
122  + (4.0d0,5.0d0), (4.0d0,5.0d0), (4.0d0,5.0d0),
123  + (4.0d0,5.0d0), (0.3d0,-0.4d0), (6.0d0,7.0d0),
124  + (6.0d0,7.0d0), (6.0d0,7.0d0), (6.0d0,7.0d0),
125  + (6.0d0,7.0d0), (6.0d0,7.0d0), (6.0d0,7.0d0),
126  + (0.1d0,-0.3d0), (8.0d0,9.0d0), (0.5d0,-0.1d0),
127  + (2.0d0,5.0d0), (2.0d0,5.0d0), (2.0d0,5.0d0),
128  + (2.0d0,5.0d0), (2.0d0,5.0d0), (0.1d0,0.1d0),
129  + (3.0d0,6.0d0), (-0.6d0,0.1d0), (4.0d0,7.0d0),
130  + (0.1d0,-0.3d0), (7.0d0,2.0d0), (7.0d0,2.0d0),
131  + (7.0d0,2.0d0), (0.3d0,0.1d0), (5.0d0,8.0d0),
132  + (0.1d0,0.4d0), (6.0d0,9.0d0), (0.4d0,0.1d0),
133  + (8.0d0,3.0d0), (0.1d0,0.2d0), (9.0d0,4.0d0)/
134  DATA strue2/0.0d0, 0.5d0, 0.6d0, 0.7d0, 0.7d0/
135  DATA strue4/0.0d0, 0.7d0, 1.0d0, 1.3d0, 1.7d0/
136  DATA ((ctrue5(i,j,1),i=1,8),j=1,5)/(0.1d0,0.1d0),
137  + (1.0d0,2.0d0), (1.0d0,2.0d0), (1.0d0,2.0d0),
138  + (1.0d0,2.0d0), (1.0d0,2.0d0), (1.0d0,2.0d0),
139  + (1.0d0,2.0d0), (-0.16d0,-0.37d0), (3.0d0,4.0d0),
140  + (3.0d0,4.0d0), (3.0d0,4.0d0), (3.0d0,4.0d0),
141  + (3.0d0,4.0d0), (3.0d0,4.0d0), (3.0d0,4.0d0),
142  + (-0.17d0,-0.19d0), (0.13d0,-0.39d0),
143  + (5.0d0,6.0d0), (5.0d0,6.0d0), (5.0d0,6.0d0),
144  + (5.0d0,6.0d0), (5.0d0,6.0d0), (5.0d0,6.0d0),
145  + (0.11d0,-0.03d0), (-0.17d0,0.46d0),
146  + (-0.17d0,-0.19d0), (7.0d0,8.0d0), (7.0d0,8.0d0),
147  + (7.0d0,8.0d0), (7.0d0,8.0d0), (7.0d0,8.0d0),
148  + (0.19d0,-0.17d0), (0.32d0,0.09d0),
149  + (0.23d0,-0.24d0), (0.18d0,0.01d0),
150  + (2.0d0,3.0d0), (2.0d0,3.0d0), (2.0d0,3.0d0),
151  + (2.0d0,3.0d0)/
152  DATA ((ctrue5(i,j,2),i=1,8),j=1,5)/(0.1d0,0.1d0),
153  + (4.0d0,5.0d0), (4.0d0,5.0d0), (4.0d0,5.0d0),
154  + (4.0d0,5.0d0), (4.0d0,5.0d0), (4.0d0,5.0d0),
155  + (4.0d0,5.0d0), (-0.16d0,-0.37d0), (6.0d0,7.0d0),
156  + (6.0d0,7.0d0), (6.0d0,7.0d0), (6.0d0,7.0d0),
157  + (6.0d0,7.0d0), (6.0d0,7.0d0), (6.0d0,7.0d0),
158  + (-0.17d0,-0.19d0), (8.0d0,9.0d0),
159  + (0.13d0,-0.39d0), (2.0d0,5.0d0), (2.0d0,5.0d0),
160  + (2.0d0,5.0d0), (2.0d0,5.0d0), (2.0d0,5.0d0),
161  + (0.11d0,-0.03d0), (3.0d0,6.0d0),
162  + (-0.17d0,0.46d0), (4.0d0,7.0d0),
163  + (-0.17d0,-0.19d0), (7.0d0,2.0d0), (7.0d0,2.0d0),
164  + (7.0d0,2.0d0), (0.19d0,-0.17d0), (5.0d0,8.0d0),
165  + (0.32d0,0.09d0), (6.0d0,9.0d0),
166  + (0.23d0,-0.24d0), (8.0d0,3.0d0),
167  + (0.18d0,0.01d0), (9.0d0,4.0d0)/
168  DATA ((ctrue6(i,j,1),i=1,8),j=1,5)/(0.1d0,0.1d0),
169  + (1.0d0,2.0d0), (1.0d0,2.0d0), (1.0d0,2.0d0),
170  + (1.0d0,2.0d0), (1.0d0,2.0d0), (1.0d0,2.0d0),
171  + (1.0d0,2.0d0), (0.09d0,-0.12d0), (3.0d0,4.0d0),
172  + (3.0d0,4.0d0), (3.0d0,4.0d0), (3.0d0,4.0d0),
173  + (3.0d0,4.0d0), (3.0d0,4.0d0), (3.0d0,4.0d0),
174  + (0.03d0,-0.09d0), (0.15d0,-0.03d0),
175  + (5.0d0,6.0d0), (5.0d0,6.0d0), (5.0d0,6.0d0),
176  + (5.0d0,6.0d0), (5.0d0,6.0d0), (5.0d0,6.0d0),
177  + (0.03d0,0.03d0), (-0.18d0,0.03d0),
178  + (0.03d0,-0.09d0), (7.0d0,8.0d0), (7.0d0,8.0d0),
179  + (7.0d0,8.0d0), (7.0d0,8.0d0), (7.0d0,8.0d0),
180  + (0.09d0,0.03d0), (0.03d0,0.12d0),
181  + (0.12d0,0.03d0), (0.03d0,0.06d0), (2.0d0,3.0d0),
182  + (2.0d0,3.0d0), (2.0d0,3.0d0), (2.0d0,3.0d0)/
183  DATA ((ctrue6(i,j,2),i=1,8),j=1,5)/(0.1d0,0.1d0),
184  + (4.0d0,5.0d0), (4.0d0,5.0d0), (4.0d0,5.0d0),
185  + (4.0d0,5.0d0), (4.0d0,5.0d0), (4.0d0,5.0d0),
186  + (4.0d0,5.0d0), (0.09d0,-0.12d0), (6.0d0,7.0d0),
187  + (6.0d0,7.0d0), (6.0d0,7.0d0), (6.0d0,7.0d0),
188  + (6.0d0,7.0d0), (6.0d0,7.0d0), (6.0d0,7.0d0),
189  + (0.03d0,-0.09d0), (8.0d0,9.0d0),
190  + (0.15d0,-0.03d0), (2.0d0,5.0d0), (2.0d0,5.0d0),
191  + (2.0d0,5.0d0), (2.0d0,5.0d0), (2.0d0,5.0d0),
192  + (0.03d0,0.03d0), (3.0d0,6.0d0),
193  + (-0.18d0,0.03d0), (4.0d0,7.0d0),
194  + (0.03d0,-0.09d0), (7.0d0,2.0d0), (7.0d0,2.0d0),
195  + (7.0d0,2.0d0), (0.09d0,0.03d0), (5.0d0,8.0d0),
196  + (0.03d0,0.12d0), (6.0d0,9.0d0), (0.12d0,0.03d0),
197  + (8.0d0,3.0d0), (0.03d0,0.06d0), (9.0d0,4.0d0)/
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 * .. DZNRM2TEST ..
210  CALL stest1(dznrm2test(n,cx,incx),strue2(np1),
211  + strue2(np1),sfac)
212  ELSE IF (icase.EQ.7) THEN
213 * .. DZASUMTEST ..
214  CALL stest1(dzasumtest(n,cx,incx),strue4(np1),
215  + strue4(np1),sfac)
216  ELSE IF (icase.EQ.8) THEN
217 * .. ZSCALTEST ..
218  CALL zscaltest(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 * .. ZDSCALTEST ..
223  CALL zdscaltest(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 * .. IZAMAXTEST ..
228  CALL itest1(izamaxtest(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 * ZSCALTEST
240 * Add a test for alpha equal to zero.
241  ca = (0.0d0,0.0d0)
242  DO 80 i = 1, 5
243  mwpct(i) = (0.0d0,0.0d0)
244  mwpcs(i) = (1.0d0,1.0d0)
245  80 CONTINUE
246  CALL zscaltest(5,ca,cx,incx)
247  CALL ctest(5,cx,mwpct,mwpcs,sfac)
248  ELSE IF (icase.EQ.9) THEN
249 * ZDSCALTEST
250 * Add a test for alpha equal to zero.
251  sa = 0.0d0
252  DO 100 i = 1, 5
253  mwpct(i) = (0.0d0,0.0d0)
254  mwpcs(i) = (1.0d0,1.0d0)
255  100 CONTINUE
256  CALL zdscaltest(5,sa,cx,incx)
257  CALL ctest(5,cx,mwpct,mwpcs,sfac)
258 * Add a test for alpha equal to one.
259  sa = 1.0d0
260  DO 120 i = 1, 5
261  mwpct(i) = cx(i)
262  mwpcs(i) = cx(i)
263  120 CONTINUE
264  CALL zdscaltest(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.0d0
268  DO 140 i = 1, 5
269  mwpct(i) = -cx(i)
270  mwpcs(i) = -cx(i)
271  140 CONTINUE
272  CALL zdscaltest(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
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: