OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
c_zblat1.f File Reference

Go to the source code of this file.

Functions/Subroutines

program zcblat1
subroutine header
subroutine check1 (sfac)
subroutine check2 (sfac)
subroutine stest (len, scomp, strue, ssize, sfac)
subroutine stest1 (scomp1, strue1, ssize, sfac)
double precision function sdiff (sa, sb)
subroutine ctest (len, ccomp, ctrue, csize, sfac)
subroutine itest1 (icomp, itrue)

Function/Subroutine Documentation

◆ check1()

subroutine check1 ( double precision sfac)

Definition at line 76 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
ctest
subroutine ctest(len, ccomp, ctrue, csize, sfac)
Definition c_zblat1.f:613
stest1
subroutine stest1(scomp1, strue1, ssize, sfac)
Definition c_zblat1.f:578
itest1
subroutine itest1(icomp, itrue)
Definition c_zblat1.f:644
max
#define max(a, b)
Definition macros.h:21

◆ check2()

subroutine check2 ( double precision sfac)

Definition at line 277 of file c_zblat1.f.

278* .. Parameters ..
279 INTEGER NOUT
280 parameter(nout=6)
281* .. Scalar Arguments ..
282 DOUBLE PRECISION SFAC
283* .. Scalars in Common ..
284 INTEGER ICASE, INCX, INCY, MODE, N
285 LOGICAL PASS
286* .. Local Scalars ..
287 COMPLEX*16 CA,ZTEMP
288 INTEGER I, J, KI, KN, KSIZE, LENX, LENY, MX, MY
289* .. Local Arrays ..
290 COMPLEX*16 CDOT(1), CSIZE1(4), CSIZE2(7,2), CSIZE3(14),
291 + CT10X(7,4,4), CT10Y(7,4,4), CT6(4,4), CT7(4,4),
292 + CT8(7,4,4), CX(7), CX1(7), CY(7), CY1(7)
293 INTEGER INCXS(4), INCYS(4), LENS(4,2), NS(4)
294* .. External Functions ..
295 EXTERNAL zdotctest, zdotutest
296* .. External Subroutines ..
297 EXTERNAL zaxpytest, zcopytest, zswaptest, ctest
298* .. Intrinsic Functions ..
299 INTRINSIC abs, min
300* .. Common blocks ..
301 COMMON /combla/icase, n, incx, incy, mode, pass
302* .. Data statements ..
303 DATA ca/(0.4d0,-0.7d0)/
304 DATA incxs/1, 2, -2, -1/
305 DATA incys/1, -2, 1, -2/
306 DATA lens/1, 1, 2, 4, 1, 1, 3, 7/
307 DATA ns/0, 1, 2, 4/
308 DATA cx1/(0.7d0,-0.8d0), (-0.4d0,-0.7d0),
309 + (-0.1d0,-0.9d0), (0.2d0,-0.8d0),
310 + (-0.9d0,-0.4d0), (0.1d0,0.4d0), (-0.6d0,0.6d0)/
311 DATA cy1/(0.6d0,-0.6d0), (-0.9d0,0.5d0),
312 + (0.7d0,-0.6d0), (0.1d0,-0.5d0), (-0.1d0,-0.2d0),
313 + (-0.5d0,-0.3d0), (0.8d0,-0.7d0)/
314 DATA ((ct8(i,j,1),i=1,7),j=1,4)/(0.6d0,-0.6d0),
315 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
316 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
317 + (0.32d0,-1.41d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
318 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
319 + (0.0d0,0.0d0), (0.32d0,-1.41d0),
320 + (-1.55d0,0.5d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
321 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
322 + (0.32d0,-1.41d0), (-1.55d0,0.5d0),
323 + (0.03d0,-0.89d0), (-0.38d0,-0.96d0),
324 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0)/
325 DATA ((ct8(i,j,2),i=1,7),j=1,4)/(0.6d0,-0.6d0),
326 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
327 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
328 + (0.32d0,-1.41d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
329 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
330 + (0.0d0,0.0d0), (-0.07d0,-0.89d0),
331 + (-0.9d0,0.5d0), (0.42d0,-1.41d0), (0.0d0,0.0d0),
332 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
333 + (0.78d0,0.06d0), (-0.9d0,0.5d0),
334 + (0.06d0,-0.13d0), (0.1d0,-0.5d0),
335 + (-0.77d0,-0.49d0), (-0.5d0,-0.3d0),
336 + (0.52d0,-1.51d0)/
337 DATA ((ct8(i,j,3),i=1,7),j=1,4)/(0.6d0,-0.6d0),
338 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
339 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
340 + (0.32d0,-1.41d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
341 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
342 + (0.0d0,0.0d0), (-0.07d0,-0.89d0),
343 + (-1.18d0,-0.31d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
344 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
345 + (0.78d0,0.06d0), (-1.54d0,0.97d0),
346 + (0.03d0,-0.89d0), (-0.18d0,-1.31d0),
347 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0)/
348 DATA ((ct8(i,j,4),i=1,7),j=1,4)/(0.6d0,-0.6d0),
349 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
350 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
351 + (0.32d0,-1.41d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
352 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
353 + (0.0d0,0.0d0), (0.32d0,-1.41d0), (-0.9d0,0.5d0),
354 + (0.05d0,-0.6d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
355 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.32d0,-1.41d0),
356 + (-0.9d0,0.5d0), (0.05d0,-0.6d0), (0.1d0,-0.5d0),
357 + (-0.77d0,-0.49d0), (-0.5d0,-0.3d0),
358 + (0.32d0,-1.16d0)/
359 DATA ct7/(0.0d0,0.0d0), (-0.06d0,-0.90d0),
360 + (0.65d0,-0.47d0), (-0.34d0,-1.22d0),
361 + (0.0d0,0.0d0), (-0.06d0,-0.90d0),
362 + (-0.59d0,-1.46d0), (-1.04d0,-0.04d0),
363 + (0.0d0,0.0d0), (-0.06d0,-0.90d0),
364 + (-0.83d0,0.59d0), (0.07d0,-0.37d0),
365 + (0.0d0,0.0d0), (-0.06d0,-0.90d0),
366 + (-0.76d0,-1.15d0), (-1.33d0,-1.82d0)/
367 DATA ct6/(0.0d0,0.0d0), (0.90d0,0.06d0),
368 + (0.91d0,-0.77d0), (1.80d0,-0.10d0),
369 + (0.0d0,0.0d0), (0.90d0,0.06d0), (1.45d0,0.74d0),
370 + (0.20d0,0.90d0), (0.0d0,0.0d0), (0.90d0,0.06d0),
371 + (-0.55d0,0.23d0), (0.83d0,-0.39d0),
372 + (0.0d0,0.0d0), (0.90d0,0.06d0), (1.04d0,0.79d0),
373 + (1.95d0,1.22d0)/
374 DATA ((ct10x(i,j,1),i=1,7),j=1,4)/(0.7d0,-0.8d0),
375 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
376 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
377 + (0.6d0,-0.6d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
378 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
379 + (0.0d0,0.0d0), (0.6d0,-0.6d0), (-0.9d0,0.5d0),
380 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
381 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.6d0,-0.6d0),
382 + (-0.9d0,0.5d0), (0.7d0,-0.6d0), (0.1d0,-0.5d0),
383 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0)/
384 DATA ((ct10x(i,j,2),i=1,7),j=1,4)/(0.7d0,-0.8d0),
385 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
386 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
387 + (0.6d0,-0.6d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
388 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
389 + (0.0d0,0.0d0), (0.7d0,-0.6d0), (-0.4d0,-0.7d0),
390 + (0.6d0,-0.6d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
391 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.8d0,-0.7d0),
392 + (-0.4d0,-0.7d0), (-0.1d0,-0.2d0),
393 + (0.2d0,-0.8d0), (0.7d0,-0.6d0), (0.1d0,0.4d0),
394 + (0.6d0,-0.6d0)/
395 DATA ((ct10x(i,j,3),i=1,7),j=1,4)/(0.7d0,-0.8d0),
396 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
397 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
398 + (0.6d0,-0.6d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
399 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
400 + (0.0d0,0.0d0), (-0.9d0,0.5d0), (-0.4d0,-0.7d0),
401 + (0.6d0,-0.6d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
402 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.1d0,-0.5d0),
403 + (-0.4d0,-0.7d0), (0.7d0,-0.6d0), (0.2d0,-0.8d0),
404 + (-0.9d0,0.5d0), (0.1d0,0.4d0), (0.6d0,-0.6d0)/
405 DATA ((ct10x(i,j,4),i=1,7),j=1,4)/(0.7d0,-0.8d0),
406 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
407 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
408 + (0.6d0,-0.6d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
409 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
410 + (0.0d0,0.0d0), (0.6d0,-0.6d0), (0.7d0,-0.6d0),
411 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
412 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.6d0,-0.6d0),
413 + (0.7d0,-0.6d0), (-0.1d0,-0.2d0), (0.8d0,-0.7d0),
414 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0)/
415 DATA ((ct10y(i,j,1),i=1,7),j=1,4)/(0.6d0,-0.6d0),
416 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
417 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
418 + (0.7d0,-0.8d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
419 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
420 + (0.0d0,0.0d0), (0.7d0,-0.8d0), (-0.4d0,-0.7d0),
421 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
422 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.7d0,-0.8d0),
423 + (-0.4d0,-0.7d0), (-0.1d0,-0.9d0),
424 + (0.2d0,-0.8d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
425 + (0.0d0,0.0d0)/
426 DATA ((ct10y(i,j,2),i=1,7),j=1,4)/(0.6d0,-0.6d0),
427 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
428 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
429 + (0.7d0,-0.8d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
430 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
431 + (0.0d0,0.0d0), (-0.1d0,-0.9d0), (-0.9d0,0.5d0),
432 + (0.7d0,-0.8d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
433 + (0.0d0,0.0d0), (0.0d0,0.0d0), (-0.6d0,0.6d0),
434 + (-0.9d0,0.5d0), (-0.9d0,-0.4d0), (0.1d0,-0.5d0),
435 + (-0.1d0,-0.9d0), (-0.5d0,-0.3d0),
436 + (0.7d0,-0.8d0)/
437 DATA ((ct10y(i,j,3),i=1,7),j=1,4)/(0.6d0,-0.6d0),
438 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
439 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
440 + (0.7d0,-0.8d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
441 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
442 + (0.0d0,0.0d0), (-0.1d0,-0.9d0), (0.7d0,-0.8d0),
443 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
444 + (0.0d0,0.0d0), (0.0d0,0.0d0), (-0.6d0,0.6d0),
445 + (-0.9d0,-0.4d0), (-0.1d0,-0.9d0),
446 + (0.7d0,-0.8d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
447 + (0.0d0,0.0d0)/
448 DATA ((ct10y(i,j,4),i=1,7),j=1,4)/(0.6d0,-0.6d0),
449 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
450 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
451 + (0.7d0,-0.8d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
452 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
453 + (0.0d0,0.0d0), (0.7d0,-0.8d0), (-0.9d0,0.5d0),
454 + (-0.4d0,-0.7d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
455 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.7d0,-0.8d0),
456 + (-0.9d0,0.5d0), (-0.4d0,-0.7d0), (0.1d0,-0.5d0),
457 + (-0.1d0,-0.9d0), (-0.5d0,-0.3d0),
458 + (0.2d0,-0.8d0)/
459 DATA csize1/(0.0d0,0.0d0), (0.9d0,0.9d0),
460 + (1.63d0,1.73d0), (2.90d0,2.78d0)/
461 DATA csize3/(0.0d0,0.0d0), (0.0d0,0.0d0),
462 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
463 + (0.0d0,0.0d0), (0.0d0,0.0d0), (1.17d0,1.17d0),
464 + (1.17d0,1.17d0), (1.17d0,1.17d0),
465 + (1.17d0,1.17d0), (1.17d0,1.17d0),
466 + (1.17d0,1.17d0), (1.17d0,1.17d0)/
467 DATA csize2/(0.0d0,0.0d0), (0.0d0,0.0d0),
468 + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
469 + (0.0d0,0.0d0), (0.0d0,0.0d0), (1.54d0,1.54d0),
470 + (1.54d0,1.54d0), (1.54d0,1.54d0),
471 + (1.54d0,1.54d0), (1.54d0,1.54d0),
472 + (1.54d0,1.54d0), (1.54d0,1.54d0)/
473* .. Executable Statements ..
474 DO 60 ki = 1, 4
475 incx = incxs(ki)
476 incy = incys(ki)
477 mx = abs(incx)
478 my = abs(incy)
479*
480 DO 40 kn = 1, 4
481 n = ns(kn)
482 ksize = min(2,kn)
483 lenx = lens(kn,mx)
484 leny = lens(kn,my)
485* .. initialize all argument arrays ..
486 DO 20 i = 1, 7
487 cx(i) = cx1(i)
488 cy(i) = cy1(i)
489 20 CONTINUE
490 IF (icase.EQ.1) THEN
491* .. ZDOTCTEST ..
492 CALL zdotctest(n,cx,incx,cy,incy,ztemp)
493 cdot(1) = ztemp
494 CALL ctest(1,cdot,ct6(kn,ki),csize1(kn),sfac)
495 ELSE IF (icase.EQ.2) THEN
496* .. ZDOTUTEST ..
497 CALL zdotutest(n,cx,incx,cy,incy,ztemp)
498 cdot(1) = ztemp
499 CALL ctest(1,cdot,ct7(kn,ki),csize1(kn),sfac)
500 ELSE IF (icase.EQ.3) THEN
501* .. ZAXPYTEST ..
502 CALL zaxpytest(n,ca,cx,incx,cy,incy)
503 CALL ctest(leny,cy,ct8(1,kn,ki),csize2(1,ksize),sfac)
504 ELSE IF (icase.EQ.4) THEN
505* .. ZCOPYTEST ..
506 CALL zcopytest(n,cx,incx,cy,incy)
507 CALL ctest(leny,cy,ct10y(1,kn,ki),csize3,1.0d0)
508 ELSE IF (icase.EQ.5) THEN
509* .. ZSWAPTEST ..
510 CALL zswaptest(n,cx,incx,cy,incy)
511 CALL ctest(lenx,cx,ct10x(1,kn,ki),csize3,1.0d0)
512 CALL ctest(leny,cy,ct10y(1,kn,ki),csize3,1.0d0)
513 ELSE
514 WRITE (nout,*) ' Shouldn''t be here in CHECK2'
515 stop
516 END IF
517*
518 40 CONTINUE
519 60 CONTINUE
520 RETURN
min
#define min(a, b)
Definition macros.h:20

◆ ctest()

subroutine ctest ( integer len,
complex*16, dimension(len) ccomp,
complex*16, dimension(len) ctrue,
complex*16, dimension(len) csize,
double precision sfac )

Definition at line 612 of file c_zblat1.f.

613* **************************** CTEST *****************************
614*
615* C.L. LAWSON, JPL, 1978 DEC 6
616*
617* .. Scalar Arguments ..
618 DOUBLE PRECISION SFAC
619 INTEGER LEN
620* .. Array Arguments ..
621 COMPLEX*16 CCOMP(LEN), CSIZE(LEN), CTRUE(LEN)
622* .. Local Scalars ..
623 INTEGER I
624* .. Local Arrays ..
625 DOUBLE PRECISION SCOMP(20), SSIZE(20), STRUE(20)
626* .. External Subroutines ..
627 EXTERNAL stest
628* .. Intrinsic Functions ..
629 INTRINSIC dimag, dble
630* .. Executable Statements ..
631 DO 20 i = 1, len
632 scomp(2*i-1) = dble(ccomp(i))
633 scomp(2*i) = dimag(ccomp(i))
634 strue(2*i-1) = dble(ctrue(i))
635 strue(2*i) = dimag(ctrue(i))
636 ssize(2*i-1) = dble(csize(i))
637 ssize(2*i) = dimag(csize(i))
638 20 CONTINUE
639*
640 CALL stest(2*len,scomp,strue,ssize,sfac)
641 RETURN
stest
subroutine stest(len, scomp, strue, ssize, sfac)
Definition c_zblat1.f:523

◆ header()

subroutine header

Definition at line 48 of file c_zblat1.f.

49* .. Parameters ..
50 INTEGER NOUT
51 parameter(nout=6)
52* .. Scalars in Common ..
53 INTEGER ICASE, INCX, INCY, MODE, N
54 LOGICAL PASS
55* .. Local Arrays ..
56 CHARACTER*15 L(10)
57* .. Common blocks ..
58 COMMON /combla/icase, n, incx, incy, mode, pass
59* .. Data statements ..
60 DATA l(1)/'CBLAS_ZDOTC'/
61 DATA l(2)/'CBLAS_ZDOTU'/
62 DATA l(3)/'CBLAS_ZAXPY'/
63 DATA l(4)/'CBLAS_ZCOPY'/
64 DATA l(5)/'CBLAS_ZSWAP'/
65 DATA l(6)/'CBLAS_DZNRM2'/
66 DATA l(7)/'CBLAS_DZASUM'/
67 DATA l(8)/'CBLAS_ZSCAL'/
68 DATA l(9)/'CBLAS_ZDSCAL'/
69 DATA l(10)/'CBLAS_IZAMAX'/
70* .. Executable Statements ..
71 WRITE (nout,99999) icase, l(icase)
72 RETURN
73*
7499999 FORMAT (/' Test of subprogram number',i3,9x,a15)

◆ itest1()

subroutine itest1 ( integer icomp,
integer itrue )

Definition at line 643 of file c_zblat1.f.

644* ********************************* ITEST1 *************************
645*
646* THIS SUBROUTINE COMPARES THE VARIABLES ICOMP AND ITRUE FOR
647* EQUALITY.
648* C. L. LAWSON, JPL, 1974 DEC 10
649*
650* .. Parameters ..
651 INTEGER NOUT
652 parameter(nout=6)
653* .. Scalar Arguments ..
654 INTEGER ICOMP, ITRUE
655* .. Scalars in Common ..
656 INTEGER ICASE, INCX, INCY, MODE, N
657 LOGICAL PASS
658* .. Local Scalars ..
659 INTEGER ID
660* .. Common blocks ..
661 COMMON /combla/icase, n, incx, incy, mode, pass
662* .. Executable Statements ..
663 IF (icomp.EQ.itrue) GO TO 40
664*
665* HERE ICOMP IS NOT EQUAL TO ITRUE.
666*
667 IF ( .NOT. pass) GO TO 20
668* PRINT FAIL MESSAGE AND HEADER.
669 pass = .false.
670 WRITE (nout,99999)
671 WRITE (nout,99998)
672 20 id = icomp - itrue
673 WRITE (nout,99997) icase, n, incx, incy, mode, icomp, itrue, id
674 40 CONTINUE
675 RETURN
676*
67799999 FORMAT (' FAIL')
67899998 FORMAT (/' CASE N INCX INCY MODE ',
679 + ' COMP TRUE DIFFERENCE',
680 + /1x)
68199997 FORMAT (1x,i4,i3,3i5,2i36,i12)
id
initmumps id
Definition multiplerhs_example.m:4

◆ sdiff()

double precision function sdiff ( double precision sa,
double precision sb )

Definition at line 602 of file c_zblat1.f.

603* ********************************* SDIFF **************************
604* COMPUTES DIFFERENCE OF TWO NUMBERS. C. L. LAWSON, JPL 1974 FEB 15
605*
606* .. Scalar Arguments ..
607 DOUBLE PRECISION SA, SB
608* .. Executable Statements ..
609 sdiff = sa - sb
610 RETURN
sdiff
double precision function sdiff(sa, sb)
Definition c_zblat1.f:603

◆ stest()

subroutine stest ( integer len,
double precision, dimension(len) scomp,
double precision, dimension(len) strue,
double precision, dimension(len) ssize,
double precision sfac )

Definition at line 522 of file c_zblat1.f.

523* ********************************* STEST **************************
524*
525* THIS SUBR COMPARES ARRAYS SCOMP() AND STRUE() OF LENGTH LEN TO
526* SEE IF THE TERM BY TERM DIFFERENCES, MULTIPLIED BY SFAC, ARE
527* NEGLIGIBLE.
528*
529* C. L. LAWSON, JPL, 1974 DEC 10
530*
531* .. Parameters ..
532 INTEGER NOUT
533 parameter(nout=6)
534* .. Scalar Arguments ..
535 DOUBLE PRECISION SFAC
536 INTEGER LEN
537* .. Array Arguments ..
538 DOUBLE PRECISION SCOMP(LEN), SSIZE(LEN), STRUE(LEN)
539* .. Scalars in Common ..
540 INTEGER ICASE, INCX, INCY, MODE, N
541 LOGICAL PASS
542* .. Local Scalars ..
543 DOUBLE PRECISION SD
544 INTEGER I
545* .. External Functions ..
546 DOUBLE PRECISION SDIFF
547 EXTERNAL sdiff
548* .. Intrinsic Functions ..
549 INTRINSIC abs
550* .. Common blocks ..
551 COMMON /combla/icase, n, incx, incy, mode, pass
552* .. Executable Statements ..
553*
554 DO 40 i = 1, len
555 sd = scomp(i) - strue(i)
556 IF (sdiff(abs(ssize(i))+abs(sfac*sd),abs(ssize(i))).EQ.0.0d0)
557 + GO TO 40
558*
559* HERE SCOMP(I) IS NOT CLOSE TO STRUE(I).
560*
561 IF ( .NOT. pass) GO TO 20
562* PRINT FAIL MESSAGE AND HEADER.
563 pass = .false.
564 WRITE (nout,99999)
565 WRITE (nout,99998)
566 20 WRITE (nout,99997) icase, n, incx, incy, mode, i, scomp(i),
567 + strue(i), sd, ssize(i)
568 40 CONTINUE
569 RETURN
570*
57199999 FORMAT (' FAIL')
57299998 FORMAT (/' CASE N INCX INCY MODE I ',
573 + ' COMP(I) TRUE(I) DIFFERENCE',
574 + ' SIZE(i)',/1X)
57599997 FORMAT (1X,I4,I3,3I5,I3,2D36.8,2D12.4)

◆ stest1()

subroutine stest1 ( double precision scomp1,
double precision strue1,
double precision, dimension(*) ssize,
double precision sfac )

Definition at line 577 of file c_zblat1.f.

578* ************************* STEST1 *****************************
579*
580* THIS IS AN INTERFACE SUBROUTINE TO ACCOMMODATE THE FORTRAN
581* REQUIREMENT THAT WHEN A DUMMY ARGUMENT IS AN ARRAY, THE
582* ACTUAL ARGUMENT MUST ALSO BE AN ARRAY OR AN ARRAY ELEMENT.
583*
584* C.L. LAWSON, JPL, 1978 DEC 6
585*
586* .. Scalar Arguments ..
587 DOUBLE PRECISION SCOMP1, SFAC, STRUE1
588* .. Array Arguments ..
589 DOUBLE PRECISION SSIZE(*)
590* .. Local Arrays ..
591 DOUBLE PRECISION SCOMP(1), STRUE(1)
592* .. External Subroutines ..
593 EXTERNAL stest
594* .. Executable Statements ..
595*
596 scomp(1) = scomp1
597 strue(1) = strue1
598 CALL stest(1,scomp,strue,ssize,sfac)
599*
600 RETURN

◆ zcblat1()

program zcblat1

Definition at line 1 of file c_zblat1.f.