1 PROGRAM ZBLAT1 2* Test program for the COMPLEX*16 Level 1 BLAS. 3* Based upon the original BLAS test routine together with: 4* F06GAF Example Program Text 5* .. Parameters .. 6 INTEGER NOUT 7 PARAMETER (NOUT=6) 8* .. Scalars in Common .. 9 INTEGER ICASE, INCX, INCY, MODE, N 10 LOGICAL PASS 11* .. Local Scalars .. 12 DOUBLE PRECISION SFAC 13 INTEGER IC 14* .. External Subroutines .. 15 EXTERNAL CHECK1, CHECK2, HEADER 16* .. Common blocks .. 17 COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS 18* .. Data statements .. 19 DATA SFAC/9.765625D-4/ 20* .. Executable Statements .. 21 WRITE (NOUT,99999) 22 DO 20 IC = 1, 10 23 ICASE = IC 24 CALL HEADER 25* 26* Initialize PASS, INCX, INCY, and MODE for a new case. 27* The value 9999 for INCX, INCY or MODE will appear in the 28* detailed output, if any, for cases that do not involve 29* these parameters. 30* 31 PASS = .TRUE. 32 INCX = 9999 33 INCY = 9999 34 MODE = 9999 35 IF (ICASE.LE.5) THEN 36 CALL CHECK2(SFAC) 37 ELSE IF (ICASE.GE.6) THEN 38 CALL CHECK1(SFAC) 39 END IF 40* -- Print 41 IF (PASS) WRITE (NOUT,99998) 42 20 CONTINUE 43 STOP 44* 4599999 FORMAT (' Complex BLAS Test Program Results',/1X) 4699998 FORMAT (' ----- PASS -----') 47 END 48 SUBROUTINE HEADER 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*6 L(10) 57* .. Common blocks .. 58 COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS 59* .. Data statements .. 60 DATA L(1)/'ZDOTC '/ 61 DATA L(2)/'ZDOTU '/ 62 DATA L(3)/'ZAXPY '/ 63 DATA L(4)/'ZCOPY '/ 64 DATA L(5)/'ZSWAP '/ 65 DATA L(6)/'DZNRM2'/ 66 DATA L(7)/'DZASUM'/ 67 DATA L(8)/'ZSCAL '/ 68 DATA L(9)/'ZDSCAL'/ 69 DATA L(10)/'IZAMAX'/ 70* .. Executable Statements .. 71 WRITE (NOUT,99999) ICASE, L(ICASE) 72 RETURN 73* 7499999 FORMAT (/' Test of subprogram number',I3,12X,A6) 75 END 76 SUBROUTINE CHECK1(SFAC) 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 DZASUM, DZNRM2 96 INTEGER IZAMAX 97 EXTERNAL DZASUM, DZNRM2, IZAMAX 98* .. External Subroutines .. 99 EXTERNAL ZSCAL, ZDSCAL, 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* .. DZNRM2 .. 210 CALL STEST1(DZNRM2(N,CX,INCX),STRUE2(NP1),STRUE2(NP1), 211 + SFAC) 212 ELSE IF (ICASE.EQ.7) THEN 213* .. DZASUM .. 214 CALL STEST1(DZASUM(N,CX,INCX),STRUE4(NP1),STRUE4(NP1), 215 + SFAC) 216 ELSE IF (ICASE.EQ.8) THEN 217* .. ZSCAL .. 218 CALL ZSCAL(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* .. ZDSCAL .. 223 CALL ZDSCAL(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* .. IZAMAX .. 228 CALL ITEST1(IZAMAX(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* ZSCAL 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 ZSCAL(5,CA,CX,INCX) 247 CALL CTEST(5,CX,MWPCT,MWPCS,SFAC) 248 ELSE IF (ICASE.EQ.9) THEN 249* ZDSCAL 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 ZDSCAL(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 ZDSCAL(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 ZDSCAL(5,SA,CX,INCX) 273 CALL CTEST(5,CX,MWPCT,MWPCS,SFAC) 274 END IF 275 RETURN 276 END 277 SUBROUTINE CHECK2(SFAC) 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 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 COMPLEX*16 ZDOTC, ZDOTU 296 EXTERNAL ZDOTC, ZDOTU 297* .. External Subroutines .. 298 EXTERNAL ZAXPY, ZCOPY, ZSWAP, CTEST 299* .. Intrinsic Functions .. 300 INTRINSIC ABS, MIN 301* .. Common blocks .. 302 COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS 303* .. Data statements .. 304 DATA CA/(0.4D0,-0.7D0)/ 305 DATA INCXS/1, 2, -2, -1/ 306 DATA INCYS/1, -2, 1, -2/ 307 DATA LENS/1, 1, 2, 4, 1, 1, 3, 7/ 308 DATA NS/0, 1, 2, 4/ 309 DATA CX1/(0.7D0,-0.8D0), (-0.4D0,-0.7D0), 310 + (-0.1D0,-0.9D0), (0.2D0,-0.8D0), 311 + (-0.9D0,-0.4D0), (0.1D0,0.4D0), (-0.6D0,0.6D0)/ 312 DATA CY1/(0.6D0,-0.6D0), (-0.9D0,0.5D0), 313 + (0.7D0,-0.6D0), (0.1D0,-0.5D0), (-0.1D0,-0.2D0), 314 + (-0.5D0,-0.3D0), (0.8D0,-0.7D0)/ 315 DATA ((CT8(I,J,1),I=1,7),J=1,4)/(0.6D0,-0.6D0), 316 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 317 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 318 + (0.32D0,-1.41D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 319 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 320 + (0.0D0,0.0D0), (0.32D0,-1.41D0), 321 + (-1.55D0,0.5D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 322 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 323 + (0.32D0,-1.41D0), (-1.55D0,0.5D0), 324 + (0.03D0,-0.89D0), (-0.38D0,-0.96D0), 325 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0)/ 326 DATA ((CT8(I,J,2),I=1,7),J=1,4)/(0.6D0,-0.6D0), 327 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 328 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 329 + (0.32D0,-1.41D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 330 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 331 + (0.0D0,0.0D0), (-0.07D0,-0.89D0), 332 + (-0.9D0,0.5D0), (0.42D0,-1.41D0), (0.0D0,0.0D0), 333 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 334 + (0.78D0,0.06D0), (-0.9D0,0.5D0), 335 + (0.06D0,-0.13D0), (0.1D0,-0.5D0), 336 + (-0.77D0,-0.49D0), (-0.5D0,-0.3D0), 337 + (0.52D0,-1.51D0)/ 338 DATA ((CT8(I,J,3),I=1,7),J=1,4)/(0.6D0,-0.6D0), 339 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 340 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 341 + (0.32D0,-1.41D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 342 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 343 + (0.0D0,0.0D0), (-0.07D0,-0.89D0), 344 + (-1.18D0,-0.31D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 345 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 346 + (0.78D0,0.06D0), (-1.54D0,0.97D0), 347 + (0.03D0,-0.89D0), (-0.18D0,-1.31D0), 348 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0)/ 349 DATA ((CT8(I,J,4),I=1,7),J=1,4)/(0.6D0,-0.6D0), 350 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 351 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 352 + (0.32D0,-1.41D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 353 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 354 + (0.0D0,0.0D0), (0.32D0,-1.41D0), (-0.9D0,0.5D0), 355 + (0.05D0,-0.6D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 356 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.32D0,-1.41D0), 357 + (-0.9D0,0.5D0), (0.05D0,-0.6D0), (0.1D0,-0.5D0), 358 + (-0.77D0,-0.49D0), (-0.5D0,-0.3D0), 359 + (0.32D0,-1.16D0)/ 360 DATA CT7/(0.0D0,0.0D0), (-0.06D0,-0.90D0), 361 + (0.65D0,-0.47D0), (-0.34D0,-1.22D0), 362 + (0.0D0,0.0D0), (-0.06D0,-0.90D0), 363 + (-0.59D0,-1.46D0), (-1.04D0,-0.04D0), 364 + (0.0D0,0.0D0), (-0.06D0,-0.90D0), 365 + (-0.83D0,0.59D0), (0.07D0,-0.37D0), 366 + (0.0D0,0.0D0), (-0.06D0,-0.90D0), 367 + (-0.76D0,-1.15D0), (-1.33D0,-1.82D0)/ 368 DATA CT6/(0.0D0,0.0D0), (0.90D0,0.06D0), 369 + (0.91D0,-0.77D0), (1.80D0,-0.10D0), 370 + (0.0D0,0.0D0), (0.90D0,0.06D0), (1.45D0,0.74D0), 371 + (0.20D0,0.90D0), (0.0D0,0.0D0), (0.90D0,0.06D0), 372 + (-0.55D0,0.23D0), (0.83D0,-0.39D0), 373 + (0.0D0,0.0D0), (0.90D0,0.06D0), (1.04D0,0.79D0), 374 + (1.95D0,1.22D0)/ 375 DATA ((CT10X(I,J,1),I=1,7),J=1,4)/(0.7D0,-0.8D0), 376 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 377 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 378 + (0.6D0,-0.6D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 379 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 380 + (0.0D0,0.0D0), (0.6D0,-0.6D0), (-0.9D0,0.5D0), 381 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 382 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.6D0,-0.6D0), 383 + (-0.9D0,0.5D0), (0.7D0,-0.6D0), (0.1D0,-0.5D0), 384 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0)/ 385 DATA ((CT10X(I,J,2),I=1,7),J=1,4)/(0.7D0,-0.8D0), 386 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 387 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 388 + (0.6D0,-0.6D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 389 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 390 + (0.0D0,0.0D0), (0.7D0,-0.6D0), (-0.4D0,-0.7D0), 391 + (0.6D0,-0.6D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 392 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.8D0,-0.7D0), 393 + (-0.4D0,-0.7D0), (-0.1D0,-0.2D0), 394 + (0.2D0,-0.8D0), (0.7D0,-0.6D0), (0.1D0,0.4D0), 395 + (0.6D0,-0.6D0)/ 396 DATA ((CT10X(I,J,3),I=1,7),J=1,4)/(0.7D0,-0.8D0), 397 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 398 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 399 + (0.6D0,-0.6D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 400 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 401 + (0.0D0,0.0D0), (-0.9D0,0.5D0), (-0.4D0,-0.7D0), 402 + (0.6D0,-0.6D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 403 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.1D0,-0.5D0), 404 + (-0.4D0,-0.7D0), (0.7D0,-0.6D0), (0.2D0,-0.8D0), 405 + (-0.9D0,0.5D0), (0.1D0,0.4D0), (0.6D0,-0.6D0)/ 406 DATA ((CT10X(I,J,4),I=1,7),J=1,4)/(0.7D0,-0.8D0), 407 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 408 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 409 + (0.6D0,-0.6D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 410 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 411 + (0.0D0,0.0D0), (0.6D0,-0.6D0), (0.7D0,-0.6D0), 412 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 413 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.6D0,-0.6D0), 414 + (0.7D0,-0.6D0), (-0.1D0,-0.2D0), (0.8D0,-0.7D0), 415 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0)/ 416 DATA ((CT10Y(I,J,1),I=1,7),J=1,4)/(0.6D0,-0.6D0), 417 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 418 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 419 + (0.7D0,-0.8D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 420 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 421 + (0.0D0,0.0D0), (0.7D0,-0.8D0), (-0.4D0,-0.7D0), 422 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 423 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.7D0,-0.8D0), 424 + (-0.4D0,-0.7D0), (-0.1D0,-0.9D0), 425 + (0.2D0,-0.8D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 426 + (0.0D0,0.0D0)/ 427 DATA ((CT10Y(I,J,2),I=1,7),J=1,4)/(0.6D0,-0.6D0), 428 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 429 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 430 + (0.7D0,-0.8D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 431 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 432 + (0.0D0,0.0D0), (-0.1D0,-0.9D0), (-0.9D0,0.5D0), 433 + (0.7D0,-0.8D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 434 + (0.0D0,0.0D0), (0.0D0,0.0D0), (-0.6D0,0.6D0), 435 + (-0.9D0,0.5D0), (-0.9D0,-0.4D0), (0.1D0,-0.5D0), 436 + (-0.1D0,-0.9D0), (-0.5D0,-0.3D0), 437 + (0.7D0,-0.8D0)/ 438 DATA ((CT10Y(I,J,3),I=1,7),J=1,4)/(0.6D0,-0.6D0), 439 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 440 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 441 + (0.7D0,-0.8D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 442 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 443 + (0.0D0,0.0D0), (-0.1D0,-0.9D0), (0.7D0,-0.8D0), 444 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 445 + (0.0D0,0.0D0), (0.0D0,0.0D0), (-0.6D0,0.6D0), 446 + (-0.9D0,-0.4D0), (-0.1D0,-0.9D0), 447 + (0.7D0,-0.8D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 448 + (0.0D0,0.0D0)/ 449 DATA ((CT10Y(I,J,4),I=1,7),J=1,4)/(0.6D0,-0.6D0), 450 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 451 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 452 + (0.7D0,-0.8D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 453 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 454 + (0.0D0,0.0D0), (0.7D0,-0.8D0), (-0.9D0,0.5D0), 455 + (-0.4D0,-0.7D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 456 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.7D0,-0.8D0), 457 + (-0.9D0,0.5D0), (-0.4D0,-0.7D0), (0.1D0,-0.5D0), 458 + (-0.1D0,-0.9D0), (-0.5D0,-0.3D0), 459 + (0.2D0,-0.8D0)/ 460 DATA CSIZE1/(0.0D0,0.0D0), (0.9D0,0.9D0), 461 + (1.63D0,1.73D0), (2.90D0,2.78D0)/ 462 DATA CSIZE3/(0.0D0,0.0D0), (0.0D0,0.0D0), 463 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 464 + (0.0D0,0.0D0), (0.0D0,0.0D0), (1.17D0,1.17D0), 465 + (1.17D0,1.17D0), (1.17D0,1.17D0), 466 + (1.17D0,1.17D0), (1.17D0,1.17D0), 467 + (1.17D0,1.17D0), (1.17D0,1.17D0)/ 468 DATA CSIZE2/(0.0D0,0.0D0), (0.0D0,0.0D0), 469 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 470 + (0.0D0,0.0D0), (0.0D0,0.0D0), (1.54D0,1.54D0), 471 + (1.54D0,1.54D0), (1.54D0,1.54D0), 472 + (1.54D0,1.54D0), (1.54D0,1.54D0), 473 + (1.54D0,1.54D0), (1.54D0,1.54D0)/ 474* .. Executable Statements .. 475 DO 60 KI = 1, 4 476 INCX = INCXS(KI) 477 INCY = INCYS(KI) 478 MX = ABS(INCX) 479 MY = ABS(INCY) 480* 481 DO 40 KN = 1, 4 482 N = NS(KN) 483 KSIZE = MIN(2,KN) 484 LENX = LENS(KN,MX) 485 LENY = LENS(KN,MY) 486* .. initialize all argument arrays .. 487 DO 20 I = 1, 7 488 CX(I) = CX1(I) 489 CY(I) = CY1(I) 490 20 CONTINUE 491 IF (ICASE.EQ.1) THEN 492* .. ZDOTC .. 493 CDOT(1) = ZDOTC(N,CX,INCX,CY,INCY) 494 CALL CTEST(1,CDOT,CT6(KN,KI),CSIZE1(KN),SFAC) 495 ELSE IF (ICASE.EQ.2) THEN 496* .. ZDOTU .. 497 CDOT(1) = ZDOTU(N,CX,INCX,CY,INCY) 498 CALL CTEST(1,CDOT,CT7(KN,KI),CSIZE1(KN),SFAC) 499 ELSE IF (ICASE.EQ.3) THEN 500* .. ZAXPY .. 501 CALL ZAXPY(N,CA,CX,INCX,CY,INCY) 502 CALL CTEST(LENY,CY,CT8(1,KN,KI),CSIZE2(1,KSIZE),SFAC) 503 ELSE IF (ICASE.EQ.4) THEN 504* .. ZCOPY .. 505 CALL ZCOPY(N,CX,INCX,CY,INCY) 506 CALL CTEST(LENY,CY,CT10Y(1,KN,KI),CSIZE3,1.0D0) 507 ELSE IF (ICASE.EQ.5) THEN 508* .. ZSWAP .. 509 CALL ZSWAP(N,CX,INCX,CY,INCY) 510 CALL CTEST(LENX,CX,CT10X(1,KN,KI),CSIZE3,1.0D0) 511 CALL CTEST(LENY,CY,CT10Y(1,KN,KI),CSIZE3,1.0D0) 512 ELSE 513 WRITE (NOUT,*) ' Shouldn''t be here in CHECK2' 514 STOP 515 END IF 516* 517 40 CONTINUE 518 60 CONTINUE 519 RETURN 520 END 521 SUBROUTINE STEST(LEN,SCOMP,STRUE,SSIZE,SFAC) 522* ********************************* STEST ************************** 523* 524* THIS SUBR COMPARES ARRAYS SCOMP() AND STRUE() OF LENGTH LEN TO 525* SEE IF THE TERM BY TERM DIFFERENCES, MULTIPLIED BY SFAC, ARE 526* NEGLIGIBLE. 527* 528* C. L. LAWSON, JPL, 1974 DEC 10 529* 530* .. Parameters .. 531 INTEGER NOUT 532 PARAMETER (NOUT=6) 533* .. Scalar Arguments .. 534 DOUBLE PRECISION SFAC 535 INTEGER LEN 536* .. Array Arguments .. 537 DOUBLE PRECISION SCOMP(LEN), SSIZE(LEN), STRUE(LEN) 538* .. Scalars in Common .. 539 INTEGER ICASE, INCX, INCY, MODE, N 540 LOGICAL PASS 541* .. Local Scalars .. 542 DOUBLE PRECISION SD 543 INTEGER I 544* .. External Functions .. 545 DOUBLE PRECISION SDIFF 546 EXTERNAL SDIFF 547* .. Intrinsic Functions .. 548 INTRINSIC ABS 549* .. Common blocks .. 550 COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS 551* .. Executable Statements .. 552* 553 DO 40 I = 1, LEN 554 SD = SCOMP(I) - STRUE(I) 555 IF (SDIFF(ABS(SSIZE(I))+ABS(SFAC*SD),ABS(SSIZE(I))).EQ.0.0D0) 556 + GO TO 40 557* 558* HERE SCOMP(I) IS NOT CLOSE TO STRUE(I). 559* 560 IF ( .NOT. PASS) GO TO 20 561* PRINT FAIL MESSAGE AND HEADER. 562 PASS = .FALSE. 563 WRITE (NOUT,99999) 564 WRITE (NOUT,99998) 565 20 WRITE (NOUT,99997) ICASE, N, INCX, INCY, MODE, I, SCOMP(I), 566 + STRUE(I), SD, SSIZE(I) 567 40 CONTINUE 568 RETURN 569* 57099999 FORMAT (' FAIL') 57199998 FORMAT (/' CASE N INCX INCY MODE I ', 572 + ' COMP(I) TRUE(I) DIFFERENCE', 573 + ' SIZE(I)',/1X) 57499997 FORMAT (1X,I4,I3,3I5,I3,2D36.8,2D12.4) 575 END 576 SUBROUTINE STEST1(SCOMP1,STRUE1,SSIZE,SFAC) 577* ************************* STEST1 ***************************** 578* 579* THIS IS AN INTERFACE SUBROUTINE TO ACCOMODATE THE FORTRAN 580* REQUIREMENT THAT WHEN A DUMMY ARGUMENT IS AN ARRAY, THE 581* ACTUAL ARGUMENT MUST ALSO BE AN ARRAY OR AN ARRAY ELEMENT. 582* 583* C.L. LAWSON, JPL, 1978 DEC 6 584* 585* .. Scalar Arguments .. 586 DOUBLE PRECISION SCOMP1, SFAC, STRUE1 587* .. Array Arguments .. 588 DOUBLE PRECISION SSIZE(*) 589* .. Local Arrays .. 590 DOUBLE PRECISION SCOMP(1), STRUE(1) 591* .. External Subroutines .. 592 EXTERNAL STEST 593* .. Executable Statements .. 594* 595 SCOMP(1) = SCOMP1 596 STRUE(1) = STRUE1 597 CALL STEST(1,SCOMP,STRUE,SSIZE,SFAC) 598* 599 RETURN 600 END 601 DOUBLE PRECISION FUNCTION SDIFF(SA,SB) 602* ********************************* SDIFF ************************** 603* COMPUTES DIFFERENCE OF TWO NUMBERS. C. L. LAWSON, JPL 1974 FEB 15 604* 605* .. Scalar Arguments .. 606 DOUBLE PRECISION SA, SB 607* .. Executable Statements .. 608 SDIFF = SA - SB 609 RETURN 610 END 611 SUBROUTINE CTEST(LEN,CCOMP,CTRUE,CSIZE,SFAC) 612* **************************** CTEST ***************************** 613* 614* C.L. LAWSON, JPL, 1978 DEC 6 615* 616* .. Scalar Arguments .. 617 DOUBLE PRECISION SFAC 618 INTEGER LEN 619* .. Array Arguments .. 620 COMPLEX*16 CCOMP(LEN), CSIZE(LEN), CTRUE(LEN) 621* .. Local Scalars .. 622 INTEGER I 623* .. Local Arrays .. 624 DOUBLE PRECISION SCOMP(20), SSIZE(20), STRUE(20) 625* .. External Subroutines .. 626 EXTERNAL STEST 627* .. Intrinsic Functions .. 628 INTRINSIC DIMAG, DBLE 629* .. Executable Statements .. 630 DO 20 I = 1, LEN 631 SCOMP(2*I-1) = DBLE(CCOMP(I)) 632 SCOMP(2*I) = DIMAG(CCOMP(I)) 633 STRUE(2*I-1) = DBLE(CTRUE(I)) 634 STRUE(2*I) = DIMAG(CTRUE(I)) 635 SSIZE(2*I-1) = DBLE(CSIZE(I)) 636 SSIZE(2*I) = DIMAG(CSIZE(I)) 637 20 CONTINUE 638* 639 CALL STEST(2*LEN,SCOMP,STRUE,SSIZE,SFAC) 640 RETURN 641 END 642 SUBROUTINE ITEST1(ICOMP,ITRUE) 643* ********************************* ITEST1 ************************* 644* 645* THIS SUBROUTINE COMPARES THE VARIABLES ICOMP AND ITRUE FOR 646* EQUALITY. 647* C. L. LAWSON, JPL, 1974 DEC 10 648* 649* .. Parameters .. 650 INTEGER NOUT 651 PARAMETER (NOUT=6) 652* .. Scalar Arguments .. 653 INTEGER ICOMP, ITRUE 654* .. Scalars in Common .. 655 INTEGER ICASE, INCX, INCY, MODE, N 656 LOGICAL PASS 657* .. Local Scalars .. 658 INTEGER ID 659* .. Common blocks .. 660 COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS 661* .. Executable Statements .. 662 IF (ICOMP.EQ.ITRUE) GO TO 40 663* 664* HERE ICOMP IS NOT EQUAL TO ITRUE. 665* 666 IF ( .NOT. PASS) GO TO 20 667* PRINT FAIL MESSAGE AND HEADER. 668 PASS = .FALSE. 669 WRITE (NOUT,99999) 670 WRITE (NOUT,99998) 671 20 ID = ICOMP - ITRUE 672 WRITE (NOUT,99997) ICASE, N, INCX, INCY, MODE, ICOMP, ITRUE, ID 673 40 CONTINUE 674 RETURN 675* 67699999 FORMAT (' FAIL') 67799998 FORMAT (/' CASE N INCX INCY MODE ', 678 + ' COMP TRUE DIFFERENCE', 679 + /1X) 68099997 FORMAT (1X,I4,I3,3I5,2I36,I12) 681 END 682