1C 2C DRIVER FOR TESTING CMLIB ROUTINES 3C "BLAS SUBPROGRAMS" 4C 5C ONE INPUT DATA CARD IS REQUIRED 6C READ(LIN,1) KPRINT,TIMES 7C 1 FORMAT(I1,E10.0) 8C 9C KPRINT = 0 NO PRINTING 10C 1 NO PRINTING FOR PASSED TESTS, SHORT MESSAGE 11C FOR FAILED TESTS 12C 2 PRINT SHORT MESSAGE FOR PASSED TESTS, FULLER 13C INFORMATION FOR FAILED TESTS 14C 3 PRINT COMPLETE QUICK-CHECK RESULTS 15C 16C ***IMPORTANT NOTE*** 17C ALL QUICK CHECKS USE ROUTINES R2MACH AND D2MACH 18C TO SET THE ERROR TOLERANCES. 19C TIMES IS A CONSTANT MULTIPLIER THAT CAN BE USED TO SCALE THE 20C VALUES OF R1MACH AND D1MACH SO THAT 21C R2MACH(I) = R1MACH(I) * TIMES FOR I=3,4,5 22C D2MACH(I) = D1MACH(I) * TIMES FOR I=3,4,5 23C THIS MAKES IT EASILY POSSIBLE TO CHANGE THE ERROR TOLERANCES 24C USED IN THE QUICK CHECKS. 25C IF TIMES .LE. 0.0 THEN TIMES IS DEFAULTED TO 1.0 26C 27C ***END NOTE*** 28C 29 COMMON/UNIT/LUN 30 COMMON/MSG/ICNT,JTEST(38) 31 COMMON/XXMULT/TIMES 32 LUN=I1MACH(2) 33 LIN=I1MACH(1) 34 ITEST=1 35C 36C READ KPRINT,TIMES PARAMETERS FROM DATA CARD.. 37C 38 READ(LIN,1) KPRINT,TIMES 391 FORMAT(I1,E10.0) 40 IF(TIMES.LE.0.) TIMES=1. 41 CALL XSETUN(LUN) 42 CALL XSETF(1) 43 CALL XERMAX(1000) 44C TEST BLAS 45 CALL BLACHK(KPRINT,IPASS) 46 ITEST=ITEST*IPASS 47C 48 IF(KPRINT.GE.1.AND.ITEST.NE.1) WRITE(LUN,2) 492 FORMAT(/' ********** WARNING -- AT LEAST ONE TEST FOR THE BLAS, 50 1 SUBLIBRARY HAS FAILED ****************** ') 51 IF(KPRINT.GE.1.AND.ITEST.EQ.1) WRITE(LUN,3) 523 FORMAT(/' ----- THE BLAS SUBLIBRARY PASSED ALL TESTS ----- ') 53 END 54 SUBROUTINE BLACHK (KPRINT,IPASS) 55C1 ********************************* TBLA *************************** 56C TEST DRIVER FOR BASIC LINEAR ALGEBRA SUBPROGRAMS. 57C C. L. LAWSON,JPL, 1974 DEC 10, 1975 MAY 28 58C2 59C MODIFIED FOR SANDIA MATH LIBRARY USE BY K. HASKELL, 6/23/77 60C UPDATED BY K. HASKELL - JUNE 23,1980 61C 62 COMMON /UNIT/ LUN 63 COMMON/COMBLA/NPRINT,ICASE,N,INCX,INCY,MODE,PASS 64 COMMON /MSG/ ICNT,JTEST 65 DIMENSION JTEST(38) 66 LOGICAL PASS 67 INTEGER ITEST(38) 68 DOUBLE PRECISION DFAC,DQFAC 69 DATA SFAC,SDFAC,DFAC,DQFAC / .625E-1, .50, .625D-1, 0.625D-1/ 70 DATA ITEST /1,1,1,1,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1, 71 1 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1/ 72C THE ZEROS IN THE ABOVE DATA STATEMENT ARE TO SUPPRESS 73C TESTING OF DQDOTI AND DQDOTA, WHICH DO NOT EXIST IN 74C NONTRIVIAL SUBROUTINES ON THE SANDIA MATH. LIBRARY. 75 NPRINT = LUN 76 ICNT=0 77C 78C 79 5 CONTINUE 80 IF (KPRINT.GE.2) WRITE (NPRINT,1005) 81 1005 FORMAT(/' QUICK CHECK OF 38 BASIC LINEAR ALGEBRA SUBROUTINES '/) 82 DO 60 ICASE=1,38 83 IF(ITEST(ICASE) .EQ. 0) GO TO 60 84 ICNT = ICNT+1 85 CALL HEADER (KPRINT) 86C 87C INITIALIZE PASS, INCX, INCY, AND MODE FOR A NEW CASE. 88C THE VALUE 9999 FOR INCX, INCY OR MODE WILL APPEAR IN THE 89C DETAILED OUTPUT, IF ANY, FOR CASES THAT DO NOT INVOLVE 90C THESE PARAMETERS. 91C 92 PASS=.TRUE. 93 INCX=9999 94 INCY=9999 95 MODE=9999 96 GO TO (12,12,12,12,12,12,12,12,12,12, 97 A 12,10,10,12,12,10,10,12,12,12, 98 B 12,12,12,12,12,11,11,11,11,11, 99 C 11,11,11,11,11,11,11,11), ICASE 100C ICASE = 12-13 OR 16-17 101 10 CALL CHECK0(SFAC,DFAC,KPRINT) 102 GO TO 50 103C ICASE = 26-38 104 11 CALL CHECK1(SFAC,DFAC,KPRINT) 105 GO TO 50 106C ICASE = 1-11, 14-15, OR 18-25 107 12 CALL CHECK2(SFAC,SDFAC,DFAC,DQFAC,KPRINT) 108 50 CONTINUE 109C PRINT 110 IF (KPRINT.GE.2 .AND. PASS) WRITE (NPRINT,1001) 111 JTEST(ICNT) = 1 112 IF (.NOT.PASS) JTEST(ICNT) = 0 113 60 CONTINUE 114 IPASS=1 115 DO 70 I = 1, ICNT 116 IPASS = IPASS*JTEST(I) 117 70 CONTINUE 118 IF (KPRINT.GE.2 .AND. IPASS.EQ.1) WRITE (NPRINT,1006) 119 IF (KPRINT.GE.1 .AND. IPASS.EQ.0) WRITE (NPRINT,1007) 120 RETURN 121 1001 FORMAT('+ PASS') 122 1006 FORMAT(/' ****************BLAS PASSED ALL TESTS***************') 123 1007 FORMAT(/' ****************BLAS FAILED SOME TESTS**************') 124 END 125 DOUBLE PRECISION FUNCTION D2MACH(I) 126 DOUBLE PRECISION D1MACH 127 COMMON/XXMULT/TIMES 128 D2MACH=D1MACH(I) 129 IF(I.EQ.1.OR. I.EQ.2) RETURN 130 D2MACH = D2MACH * DBLE(TIMES) 131 RETURN 132 END 133 REAL FUNCTION R2MACH(I) 134 COMMON/XXMULT/TIMES 135 R2MACH=R1MACH(I) 136 IF(I.EQ.1.OR. I.EQ.2) RETURN 137 R2MACH = R2MACH * TIMES 138 RETURN 139 END 140 SUBROUTINE CHECK0(SFAC,DFAC,KPRINT) 141C1 ********************************* CHECK0 ************************* 142C THIS SUBROUTINE TESTS SUBPROGRAMS 12-13 AND 16-17. 143C THESE SUBPROGRAMS HAVE NO ARRAY ARGUMENTS. 144C 145C C. L. LAWSON, JPL, 1975 MAR 07, MAY 28 146C R. J. HANSON, J. A. WISNIEWSKI, SANDIA LABS, APRIL 25,1977. 147C2 148 COMMON/COMBLA/NPRINT,ICASE,N,INCX,INCY,MODE,PASS 149 LOGICAL PASS 150 REAL STRUE(9),STEMP(9) 151 DOUBLE PRECISION DC,DS,DA1(8),DB1(8),DC1(8),DS1(8) 152 DOUBLE PRECISION DA,DATRUE(8),DBTRUE(8),DZERO,DFAC,DB 153 DOUBLE PRECISION DAB(4,9),DTEMP(9),DTRUE(9,9),D12 154 DATA ZERO, DZERO / 0., 0.D0 / 155 DATA DA1/ .3D0, .4D0, -.3D0, -.4D0, -.3D0, 0.D0, 0.D0, 1.D0/ 156 DATA DB1/ .4D0, .3D0, .4D0, .3D0, -.4D0, 0.D0, 1.D0, 0.D0/ 157 DATA DC1/ .6D0, .8D0, -.6D0, .8D0, .6D0, 1.D0, 0.D0, 1.D0/ 158 DATA DS1/ .8D0, .6D0, .8D0, -.6D0, .8D0, 0.D0, 1.D0, 0.D0/ 159 DATA DATRUE/ .5D0, .5D0, .5D0, -.5D0, -.5D0, 0.D0, 1.D0, 1.D0/ 160 DATA DBTRUE/ 0.D0, .6D0, 0.D0, -.6D0, 0.D0, 0.D0, 1.D0, 0.D0/ 161C INPUT FOR MODIFIED GIVENS 162 DATA DAB/ .1D0,.3D0,1.2D0,.2D0, 163 A .7D0, .2D0, .6D0, 4.2D0, 164 B 0.D0,0.D0,0.D0,0.D0, 165 C 4.D0, -1.D0, 2.D0, 4.D0, 166 D 6.D-10, 2.D-2, 1.D5, 10.D0, 167 E 4.D10, 2.D-2, 1.D-5, 10.D0, 168 F 2.D-10, 4.D-2, 1.D5, 10.D0, 169 G 2.D10, 4.D-2, 1.D-5, 10.D0, 170 H 4.D0, -2.D0, 8.D0, 4.D0 / 171C TRUE RESULTS FOR MODIFIED GIVENS 172 DATA DTRUE/0.D0,0.D0, 1.3D0, .2D0, 0.D0,0.D0,0.D0, .5D0, 0.D0, 173 A 0.D0,0.D0, 4.5D0, 4.2D0, 1.D0, .5D0, 0.D0,0.D0,0.D0, 174 B 0.D0,0.D0,0.D0,0.D0, -2.D0, 0.D0,0.D0,0.D0,0.D0, 175 C 0.D0,0.D0,0.D0, 4.D0, -1.D0, 0.D0,0.D0,0.D0,0.D0, 176 D 0.D0, 15.D-3, 0.D0, 10.D0, -1.D0, 0.D0, -1.D-4, 177 E 0.D0, 1.D0, 178 F 0.D0,0.D0, 6144.D-5, 10.D0, -1.D0, 4096.D0, -1.D6, 179 G 0.D0, 1.D0, 180 H 0.D0,0.D0,15.D0,10.D0,-1.D0, 5.D-5, 0.D0,1.D0,0.D0, 181 I 0.D0,0.D0, 15.D0, 10.D0, -1. D0, 5.D5, -4096.D0, 182 J 1.D0, 4096.D-6, 183 K 0.D0,0.D0, 7.D0, 4.D0, 0.D0,0.D0, -.5D0, -.25D0, 0.D0/ 184C 4096 = 2 ** 12 185 DATA D12 /4096.D0/ 186C 187C COMPUTE TRUE VALUES WHICH CANNOT BE PRESTORED 188C IN DECIMAL NOTATION. 189 DTRUE(1,1) = 12.D0 / 130.D0 190 DTRUE(2,1) = 36.D0 / 130.D0 191 DTRUE(7,1) = -1.D0 / 6.D0 192 DTRUE(1,2) = 14.D0 / 75.D0 193 DTRUE(2,2) = 49.D0 / 75.D0 194 DTRUE(9,2) = 1.D0 / 7.D0 195 DTRUE(1,5) = 45.D-11 * (D12 * D12) 196 DTRUE(3,5) = 4.D5 / (3.D0 * D12) 197 DTRUE(6,5) = 1.D0 / D12 198 DTRUE(8,5) = 1.D4 / (3.D0 * D12) 199 DTRUE(1,6) = 4.D10 / (1.5D0 * D12 * D12) 200 DTRUE(2,6) = 2.D-2 / 1.5D0 201 DTRUE(8,6) = 5.D-7 * D12 202 DTRUE(1,7) = 4.D0 / 150.D0 203 DTRUE(2,7) = (2.D-10 / 1.5D0) * (D12 * D12) 204 DTRUE(7,7) = -DTRUE(6,5) 205 DTRUE(9,7) = 1.D4 / D12 206 DTRUE(1,8) = DTRUE(1,7) 207 DTRUE(2,8) = 2.D10 / (1.5D0 * D12 * D12) 208 DTRUE(1,9) = 32.D0 / 7.D0 209 DTRUE(2,9) = -16.D0 / 7.D0 210 DBTRUE(1) = 1.D0/.6D0 211 DBTRUE(3) = -1.D0/.6D0 212 DBTRUE(5) = 1.D0/.6D0 213C 214 JUMP= ICASE-11 215 DO 500 K = 1, 9 216C SET N=K FOR IDENTIFICATION IN OUTPUT IF ANY. 217 N=K 218C BRANCH TO SELECT SUBPROGRAM TO BE TESTED. 219C 220 GO TO (120,130,999,999,160,170), JUMP 221C 12. SROTG 222 120 IF(K.GT.8) GO TO 600 223 SA=SNGL(DA1(K)) 224 SB = SNGL(DB1(K)) 225 CALL SROTG(SA,SB,SC,SS) 226 CALL STEST(1,SA,SNGL(DATRUE(K)),SNGL(DATRUE(K)),SFAC,KPRINT) 227 CALL STEST(1,SB,SNGL(DBTRUE(K)),SNGL(DBTRUE(K)),SFAC,KPRINT) 228 CALL STEST(1,SC,SNGL(DC1(K)),SNGL(DC1(K)),SFAC,KPRINT) 229 CALL STEST(1,SS,SNGL(DS1(K)),SNGL(DS1(K)),SFAC,KPRINT) 230 GO TO 500 231C 13. DROTG 232 130 IF(K.GT.8) GO TO 600 233 DA=DA1(K) 234 DB = DB1(K) 235 CALL DROTG(DA,DB,DC,DS) 236 CALL DTEST(1,DA,DATRUE(K),DATRUE(K),DFAC,KPRINT) 237 CALL DTEST(1,DB,DBTRUE(K),DBTRUE(K),DFAC,KPRINT) 238 CALL DTEST(1,DC,DC1(K),DC1(K),DFAC,KPRINT) 239 CALL DTEST(1,DS,DS1(K),DS1(K),DFAC,KPRINT) 240 GO TO 500 241C 16. SROTMG 242 160 CONTINUE 243 DO 162 I = 1, 4 244 STEMP(I) = SNGL(DAB(I,K)) 245 STEMP(I+4) = ZERO 246 162 CONTINUE 247 STEMP(9) = ZERO 248 CALL SROTMG(STEMP(1),STEMP(2),STEMP(3),STEMP(4),STEMP(5)) 249C 250 DO 166 I = 1, 9 251 166 STRUE(I) = SNGL(DTRUE(I,K)) 252 CALL STEST(9,STEMP,STRUE,STRUE,SFAC,KPRINT) 253 GO TO 500 254C 17. DROTMG 255 170 CONTINUE 256 DO 172 I = 1, 4 257 DTEMP(I) = DAB(I,K) 258 DTEMP(I+4) = DZERO 259 172 CONTINUE 260 DTEMP(9) = DZERO 261 CALL DROTMG(DTEMP(1),DTEMP(2),DTEMP(3),DTEMP(4),DTEMP(5)) 262 CALL DTEST(9,DTEMP,DTRUE(1,K),DTRUE(1,K),DFAC,KPRINT) 263 500 CONTINUE 264 600 RETURN 265C THE FOLLOWING STOP SHOULD NEVER BE REACHED. 266 999 STOP 267 END 268 SUBROUTINE CHECK1(SFAC,DFAC,KPRINT) 269C1 ********************************* CHECK1 ************************* 270C THIS SUBPROGRAM TESTS THE INCREMENTING AND ACCURACY OF THE LINEAR 271C ALGEBRA SUBPROGRAMS 26 - 38 (SNRM2 TO ICAMAX). STORED RESULTS ARE 272C COMPARED WITH THE RESULT RETURNED BY THE SUBPROGRAM. 273C 274C THESE SUBPROGRAMS REQUIRE A SINGLE VECTOR ARGUMENT. 275C 276C ICASE DESIGNATES WHICH SUBPROGRAM TO TEST. 277C 26 .LE. ICASE .LE. 38 278C C. L. LAWSON, JPL, 1974 DEC 10, MAY 28 279C2 280 COMMON/COMBLA/NPRINT,ICASE,N,INCX,INCY,MODE,PASS 281 LOGICAL PASS 282 INTEGER ITRUE2(5),ITRUE3(5) 283 DOUBLE PRECISION DA,DX(8) 284 DOUBLE PRECISION DV(8,5,2) 285 DOUBLE PRECISION DFAC 286 DOUBLE PRECISION DNRM2,DASUM 287 DOUBLE PRECISION DTRUE1(5),DTRUE3(5),DTRUE5(8,5,2) 288 REAL STRUE2(5),STRUE4(5),STRUE(8),SX(8) 289 COMPLEX CA,CV(8,5,2),CTRUE5(8,5,2),CTRUE6(8,5,2),CX(8) 290C 291 DATA SA, DA, CA / .3, .3D0, (.4,-.7) / 292 DATA DV/.1D0,2.D0,2.D0,2.D0,2.D0,2.D0,2.D0,2.D0, 293 1 .3D0,3.D0,3.D0,3.D0,3.D0,3.D0,3.D0,3.D0, 294 2 .3D0,-.4D0,4.D0,4.D0,4.D0,4.D0,4.D0,4.D0, 295 3 .2D0,-.6D0,.3D0,5.D0,5.D0,5.D0,5.D0,5.D0, 296 4 .1D0,-.3D0,.5D0,-.1D0,6.D0,6.D0,6.D0,6.D0, 297 5 .1D0,8.D0,8.D0,8.D0,8.D0,8.D0,8.D0,8.D0, 298 6 .3D0,9.D0,9.D0,9.D0,9.D0,9.D0,9.D0,9.D0, 299 7 .3D0,2.D0,-.4D0,2.D0,2.D0,2.D0,2.D0,2.D0, 300 8 .2D0,3.D0,-.6D0,5.D0,.3D0,2.D0,2.D0,2.D0, 301 9 .1D0,4.D0,-.3D0,6.D0,-.5D0,7.D0,-.1D0, 3.D0/ 302C COMPLEX TEST VECTORS 303 DATA CV/ 304 1(.1,.1),(1.,2.),(1.,2.),(1.,2.),(1.,2.),(1.,2.),(1.,2.),(1.,2.), 305 2(.3,-.4),(3.,4.),(3.,4.),(3.,4.),(3.,4.),(3.,4.),(3.,4.),(3.,4.), 306 3(.1,-.3),(.5,-.1),(5.,6.),(5.,6.),(5.,6.),(5.,6.),(5.,6.),(5.,6.), 307 4(.1,.1),(-.6,.1),(.1,-.3),(7.,8.),(7.,8.),(7.,8.),(7.,8.),(7.,8.), 308 5(.3,.1),(.1,.4),(.4,.1),(.1,.2),(2.,3.),(2.,3.),(2.,3.),(2.,3.), 309 6(.1,.1),(4.,5.),(4.,5.),(4.,5.),(4.,5.),(4.,5.),(4.,5.),(4.,5.), 310 7(.3,-.4),(6.,7.),(6.,7.),(6.,7.),(6.,7.),(6.,7.),(6.,7.),(6.,7.), 311 8(.1,-.3),(8.,9.),(.5,-.1),(2.,5.),(2.,5.),(2.,5.),(2.,5.),(2.,5.), 312 9(.1,.1),(3.,6.),(-.6,.1),(4.,7.),(.1,-.3),(7.,2.),(7.,2.),(7.,2.), 313 T(.3,.1),(5.,8.),(.1,.4),(6.,9.),(.4,.1),(8.,3.),(.1,.2),(9.,4.) / 314C 315 DATA STRUE2/.0,.5,.6,.7,.7/ 316 DATA STRUE4/.0,.7,1.,1.3,1.7/ 317 DATA DTRUE1/.0D0,.3D0,.5D0,.7D0,.6D0/ 318 DATA DTRUE3/.0D0,.3D0,.7D0,1.1D0,1.D0/ 319 DATA DTRUE5/.10D0,2.D0,2.D0,2.D0,2.D0,2.D0,2.D0,2.D0, 320 1 .09D0,3.D0,3.D0,3.D0,3.D0,3.D0,3.D0,3.D0, 321 2 .09D0,-.12D0,4.D0,4.D0,4.D0,4.D0,4.D0,4.D0, 322 3 .06D0,-.18D0,.09D0,5.D0,5.D0,5.D0,5.D0,5.D0, 323 4 .03D0,-.09D0,.15D0,-.03D0,6.D0,6.D0,6.D0,6.D0, 324 5 .10D0,8.D0,8.D0,8.D0,8.D0,8.D0,8.D0,8.D0, 325 6 .09D0,9.D0,9.D0,9.D0,9.D0,9.D0,9.D0,9.D0, 326 7 .09D0,2.D0,-.12D0,2.D0,2.D0,2.D0,2.D0,2.D0, 327 8 .06D0,3.D0,-.18D0,5.D0,.09D0,2.D0,2.D0,2.D0, 328 9 .03D0,4.D0, -.09D0,6.D0, -.15D0,7.D0, -.03D0, 3.D0/ 329C 330 DATA CTRUE5/ 331 A(.1,.1),(1.,2.),(1.,2.),(1.,2.),(1.,2.),(1.,2.),(1.,2.),(1.,2.), 332 B(-.16,-.37),(3.,4.),(3.,4.),(3.,4.),(3.,4.),(3.,4.),(3.,4.), 333 C (3.,4.), 334 D(-.17,-.19),(.13,-.39),(5.,6.),(5.,6.),(5.,6.),(5.,6.),(5.,6.), 335 E (5.,6.), 336 F(.11,-.03),(-.17,.46),(-.17,-.19),(7.,8.),(7.,8.),(7.,8.),(7.,8.), 337 G (7.,8.), 338 H(.19,-.17),(.32,.09),(.23,-.24),(.18,.01),(2.,3.),(2.,3.),(2.,3.), 339 I (2.,3.), 340 J(.1,.1),(4.,5.),(4.,5.),(4.,5.),(4.,5.),(4.,5.),(4.,5.),(4.,5.), 341 K(-.16,-.37),(6.,7.),(6.,7.),(6.,7.),(6.,7.),(6.,7.),(6.,7.), 342 L (6.,7.), 343 M(-.17,-.19),(8.,9.),(.13,-.39),(2.,5.),(2.,5.),(2.,5.),(2.,5.), 344 N (2.,5.), 345 O(.11,-.03),(3.,6.),(-.17,.46),(4.,7.),(-.17,-.19),(7.,2.),(7.,2.), 346 P (7.,2.), 347 Q(.19,-.17),(5.,8.),(.32,.09),(6.,9.),(.23,-.24),(8.,3.),(.18,.01), 348 R (9.,4.) / 349C 350 DATA CTRUE6/ 351 A(.1,.1),(1.,2.),(1.,2.),(1.,2.),(1.,2.),(1.,2.),(1.,2.),(1.,2.), 352 B(.09,-.12),(3.,4.),(3.,4.),(3.,4.),(3.,4.),(3.,4.),(3.,4.), 353 C (3.,4.), 354 D(.03,-.09),(.15,-.03),(5.,6.),(5.,6.),(5.,6.),(5.,6.),(5.,6.), 355 E (5.,6.), 356 F(.03,.03),(-.18,.03),(.03,-.09),(7.,8.),(7.,8.),(7.,8.),(7.,8.), 357 G (7.,8.), 358 H(.09,.03),(.03,.12),(.12,.03),(.03,.06),(2.,3.),(2.,3.),(2.,3.), 359 I (2.,3.), 360 J(.1,.1),(4.,5.),(4.,5.),(4.,5.),(4.,5.),(4.,5.),(4.,5.),(4.,5.), 361 K(.09,-.12),(6.,7.),(6.,7.),(6.,7.),(6.,7.),(6.,7.),(6.,7.), 362 L (6.,7.), 363 M(.03,-.09),(8.,9.),(.15,-.03),(2.,5.),(2.,5.),(2.,5.),(2.,5.), 364 N (2.,5.), 365 O(.03,.03),(3.,6.),(-.18,.03),(4.,7.),(.03,-.09),(7.,2.),(7.,2.), 366 P (7.,2.), 367 Q(.09,.03),(5.,8.),(.03,.12),(6.,9.),(.12,.03),(8.,3.),(.03,.06), 368 R (9.,4.) / 369C 370C 371 DATA ITRUE2/ 0, 1, 2, 2, 3/ 372 DATA ITRUE3/ 0, 1, 2, 2, 2/ 373C 374 JUMP=ICASE-25 375 DO 520 INCX=1,2 376 DO 500 NP1=1,5 377 N=NP1-1 378 LEN= 2*MAX0(N,1) 379C SET VECTOR ARGUMENTS. 380 DO 22 I = 1, LEN 381 SX(I) = SNGL(DV(I,NP1,INCX)) 382 DX(I) = DV(I,NP1,INCX) 383 22 CX(I) = CV(I,NP1,INCX) 384C 385C BRANCH TO INVOKE SUBPROGRAM TO BE TESTED. 386C 387 GO TO (260,270,280,290,300,310,320, 388 * 330,340,350,360,370,380),JUMP 389C 26. SNRM2 390 260 STEMP=SNGL(DTRUE1(NP1)) 391 CALL STEST(1,SNRM2(N,SX,INCX),STEMP,STEMP,SFAC,KPRINT) 392 GO TO 500 393C 27. DNRM2 394 270 CALL DTEST(1,DNRM2(N,DX,INCX),DTRUE1(NP1),DTRUE1(NP1),DFAC, 395 1 KPRINT) 396 GO TO 500 397C 28. SCNRM2 398 280 CALL STEST(1,SCNRM2(N,CX,INCX),STRUE2(NP1),STRUE2(NP1), 399 1 SFAC,KPRINT) 400 GO TO 500 401C 29. SASUM 402 290 STEMP=SNGL(DTRUE3(NP1)) 403 CALL STEST(1,SASUM(N,SX,INCX),STEMP,STEMP,SFAC,KPRINT) 404 GO TO 500 405C 30. DASUM 406 300 CALL DTEST(1,DASUM(N,DX,INCX),DTRUE3(NP1),DTRUE3(NP1),DFAC, 407 1 KPRINT) 408 GO TO 500 409C 31. SCASUM 410 310 CALL STEST(1,SCASUM(N,CX,INCX),STRUE4(NP1),STRUE4(NP1),SFAC, 411 1 KPRINT) 412 GO TO 500 413C 32. SSCALE 414 320 CALL SSCAL(N,SA,SX,INCX) 415 DO 322 I = 1, LEN 416 322 STRUE(I) = SNGL(DTRUE5(I,NP1,INCX)) 417 CALL STEST(LEN,SX,STRUE,STRUE,SFAC,KPRINT) 418 GO TO 500 419C 33. DSCALE 420 330 CALL DSCAL(N,DA,DX,INCX) 421 CALL DTEST(LEN,DX,DTRUE5(1,NP1,INCX),DTRUE5(1,NP1,INCX), 422 1 DFAC,KPRINT) 423 GO TO 500 424C 34. CSCALE 425 340 CALL CSCAL(N,CA,CX,INCX) 426 CALL STEST(2*LEN,CX,CTRUE5(1,NP1,INCX),CTRUE5(1,NP1,INCX), 427 1 SFAC,KPRINT) 428 GO TO 500 429C 35. CSSCAL 430 350 CALL CSSCAL(N,SA,CX,INCX) 431 CALL STEST(2*LEN,CX,CTRUE6(1,NP1,INCX),CTRUE6(1,NP1,INCX), 432 1 SFAC,KPRINT) 433 GO TO 500 434C 36. ISAMAX 435 360 CALL ITEST(1,ISAMAX(N,SX,INCX),ITRUE2(NP1),KPRINT) 436 GO TO 500 437C 37. IDAMAX 438 370 CALL ITEST(1,IDAMAX(N,DX,INCX),ITRUE2(NP1),KPRINT) 439 GO TO 500 440C 38. ICAMAX 441 380 CALL ITEST(1,ICAMAX(N,CX,INCX),ITRUE3(NP1),KPRINT) 442C 443 500 CONTINUE 444 520 CONTINUE 445 RETURN 446 END 447 SUBROUTINE CHECK2(SFAC,SDFAC,DFAC,DQFAC,KPRINT) 448C1 ********************************* CHECK2 ************************* 449C THIS SUBPROGRAM TESTS THE BASIC LINEAR ALGEBRA SUBPROGRAMS 1-11, 450C 14-15, AND 18-25. SUBPROGRAMS IN THIS SET EACH REQUIRE TWO ARRAYS 451C IN THE PARAMETER LIST. 452C 453C C. L. LAWSON, JPL, 1975 FEB 26, APR 29, MAY 8, MAY 28 454C2 455 COMMON/COMBLA/NPRINT,ICASE,N,INCX,INCY,MODE,PASS 456C 457 LOGICAL PASS 458 INTEGER INCXS(4),INCYS(4),LENS(4,2),NS(4) 459 REAL SX(7),SY(7),STX(7),STY(7),SSIZE1(4),SSIZE2(14,2) 460 REAL SSIZE(7),QC(10),SPARAM(5),ST7B(4,4),SSIZE3(4) 461 DOUBLE PRECISION DX(7),DA,DX1(7),DY1(7),DY(7),DT7(4,4),DT8(7,4,4) 462 DOUBLE PRECISION DX2(7), DY2(7), DT2(4,4,2), DPARAM(5), DPAR(5,4) 463 DOUBLE PRECISION DSDOT,DDOT,DQDOTI,DQDOTA,DFAC,DQFAC 464 DOUBLE PRECISION DT10X(7,4,4),DT10Y(7,4,4),DB 465 DOUBLE PRECISION DSIZE1(4),DSIZE2(7,2),DSIZE(7) 466 DOUBLE PRECISION DC,DS,DT9X(7,4,4),DT9Y(7,4,4),DTX(7),DTY(7) 467 DOUBLE PRECISION DT19X(7,4,16),DT19XA(7,4,4),DT19XB(7,4,4) 468 DOUBLE PRECISION DT19XC(7,4,4),DT19XD(7,4,4),DT19Y(7,4,16) 469 DOUBLE PRECISION DT19YA(7,4,4),DT19YB(7,4,4),DT19YC(7,4,4) 470 DOUBLE PRECISION DT19YD(7,4,4) 471C 472 EQUIVALENCE (DT19X(1,1,1),DT19XA(1,1,1)),(DT19X(1,1,5), 473 A DT19XB(1,1,1)),(DT19X(1,1,9),DT19XC(1,1,1)), 474 B (DT19X(1,1,13),DT19XD(1,1,1)) 475 EQUIVALENCE (DT19Y(1,1,1),DT19YA(1,1,1)),(DT19Y(1,1,5), 476 A DT19YB(1,1,1)),(DT19Y(1,1,9),DT19YC(1,1,1)), 477 B (DT19Y(1,1,13),DT19YD(1,1,1)) 478 COMPLEX CX(7),CA,CX1(7),CY1(7),CY(7),CT6(4,4),CT7(4,4) 479 COMPLEX CT8(7,4,4),CSIZE1(4),CSIZE2(7,2) 480 COMPLEX CT10X(7,4,4), CT10Y(7,4,4) 481 COMPLEX CDOTC,CDOTU 482 DATA SA,DA,CA,DB,SB/.3,.3D0,(.4,-.7),.25D0,.1/ 483 DATA INCXS/ 1, 2, -2, -1 / 484 DATA INCYS/ 1, -2, 1, -2 / 485 DATA LENS/1, 1, 2, 4, 1, 1, 3, 7/ 486 DATA NS / 0, 1, 2, 4 / 487 DATA SC,SS,DC,DS/ .8,.6,.8D0,.6D0/ 488 DATA DX1/ .6D0, .1D0,-.5D0, .8D0, .9D0,-.3D0,-.4D0/ 489 DATA DY1/ .5D0,-.9D0, .3D0, .7D0,-.6D0, .2D0, .8D0/ 490 DATA DX2/ 1.D0,.01D0, .02D0,1.D0,.06D0, 2.D0, 1.D0/ 491 DATA DY2/ 1.D0,.04D0,-.03D0,-1.D0,.05D0,3.D0,-1.D0/ 492C THE TERMS D11(3,2) AND D11(4,2) WILL BE SET BY 493C COMPUTATION AT RUN TIME. 494 DATA CX1/(.7,-.8),(-.4,-.7),(-.1,-.9),(.2,-.8),(-.9,-.4),(.1,.4), 495 * (-.6,.6)/ 496 DATA CY1/(.6,-.6),(-.9,.5),(.7,-.6),(.1,-.5),(-.1,-.2),(-.5,-.3), 497 * (.8,-.7) / 498C 499C FOR DQDOTI AND DQDOTA 500C 501 DATA DT2/0.25D0,1.25D0,1.2504D0,0.2498D0, 502 A 0.25D0,1.25D0,0.24D0,0.2492D0, 503 B 0.25D0,1.25D0,0.31D0,0.2518D0, 504 C 0.25D0,1.25D0,1.2497D0,0.2507D0, 505 D 0.D0,2.D0,2.0008D0,-.0004D0, 506 E 0.D0,2.D0,-.02D0,-.0016D0, 507 F 0.D0,2.D0,.12D0,.0036D0, 508 G 0.D0,2.D0,1.9994D0,.0014D0/ 509 DATA DT7/ 0.D0,.30D0,.21D0,.62D0, 0.D0,.30D0,-.07D0,.85D0, 510 * 0.D0,.30D0,-.79D0,-.74D0, 0.D0,.30D0,.33D0,1.27D0/ 511 DATA ST7B/ .1, .4, .31, .72, .1, .4, .03, .95, 512 * .1, .4, -.69, -.64, .1, .4, .43, 1.37/ 513C 514C FOR CDOTU 515C 516 DATA CT7/(0.,0.),(-.06,-.90),(.65,-.47),(-.34,-1.22), 517 1 (0.,0.),(-.06,-.90),(-.59,-1.46),(-1.04,-.04), 518 2 (0.,0.),(-.06,-.90),(-.83,.59), ( .07,-.37), 519 3 (0.,0.),(-.06,-.90),(-.76,-1.15),(-1.33,-1.82)/ 520C 521C FOR CDOTC 522C 523 DATA CT6/(0.,0.),(.90,0.06), (.91,-.77), (1.80,-.10), 524 A (0.,0.),(.90,0.06), (1.45,.74), (.20,.90), 525 B (0.,0.),(.90,0.06), (-.55,.23), (.83,-.39), 526 C (0.,0.),(.90,0.06), (1.04,0.79), (1.95,1.22)/ 527C 528 DATA DT8/.5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 529 1 .68D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 530 2 .68D0,-.87D0, 0.D0,0.D0,0.D0,0.D0,0.D0, 531 3 .68D0,-.87D0,.15D0,.94D0, 0.D0,0.D0,0.D0, 532 4 .5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 533 5 .68D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 534 6 .35D0,-.9D0,.48D0, 0.D0,0.D0,0.D0,0.D0, 535 7 .38D0,-.9D0,.57D0,.7D0,-.75D0,.2D0,.98D0, 536 8 .5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 537 9 .68D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 538 A .35D0,-.72D0, 0.D0,0.D0,0.D0,0.D0,0.D0, 539 B .38D0,-.63D0,.15D0,.88D0, 0.D0,0.D0,0.D0, 540 C .5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 541 D .68D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 542 E .68D0,-.9D0,.33D0, 0.D0,0.D0,0.D0,0.D0, 543 F .68D0,-.9D0,.33D0,.7D0,-.75D0,.2D0,1.04D0/ 544C 545 DATA CT8/ 546 A(.6,-.6),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.), 547 B(.32,-1.41),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.), 548 C(.32,-1.41),(-1.55,.5),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.), 549 D(.32,-1.41),(-1.55,.5),(.03,-.89),(-.38,-.96),(0.,0.),(0.,0.), 550 E (0.,0.), 551 F(.6,-.6),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.), 552 G(.32,-1.41),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.), 553 H(-.07,-.89),(-.9,.5),(.42,-1.41),(0.,0.),(0.,0.),(0.,0.),(0.,0.), 554 I(.78,.06),(-.9,.5),(.06,-.13),(.1,-.5),(-.77,-.49),(-.5,-.3), 555 J (.52,-1.51), 556 K(.6,-.6),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.), 557 L(.32,-1.41),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.), 558 M(-.07,-.89),(-1.18,-.31),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.), 559 N(.78,.06),(-1.54,.97),(.03,-.89),(-.18,-1.31),(0.,0.),(0.,0.), 560 O(0.,0.),(.6,-.6),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.), 561 P(.32,-1.41),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.), 562 Q(.32,-1.41),(-.9,.5),(.05,-.6),(0.,0.),(0.,0.),(0.,0.),(0.,0.), 563 R(.32,-1.41),(-.9,.5),(.05,-.6),(.1,-.5),(-.77,-.49),(-.5,-.3), 564 S (.32,-1.16) / 565C 566C 567C TRUE X VALUES AFTER ROTATION USING SROT OR DROT. 568 DATA DT9X/.6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 569 A .78D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 570 B .78D0,-.46D0, 0.D0,0.D0,0.D0,0.D0,0.D0, 571 C .78D0,-.46D0,-.22D0,1.06D0, 0.D0,0.D0,0.D0, 572 D .6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 573 E .78D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 574 F .66D0,.1D0,-.1D0, 0.D0,0.D0,0.D0,0.D0, 575 G .96D0,.1D0,-.76D0,.8D0,.90D0,-.3D0,-.02D0, 576 H .6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 577 I .78D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 578 J -.06D0,.1D0,-.1D0, 0.D0,0.D0,0.D0,0.D0, 579 K .90D0,.1D0,-.22D0,.8D0,.18D0,-.3D0,-.02D0, 580 L .6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 581 M .78D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 582 N .78D0,.26D0, 0.D0,0.D0,0.D0,0.D0,0.D0, 583 O .78D0,.26D0,-.76D0,1.12D0, 0.D0,0.D0,0.D0/ 584C 585C TRUE Y VALUES AFTER ROTATION USING SROT OR DROT. 586C 587 DATA DT9Y/ .5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 588 A .04D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 589 B .04D0,-.78D0, 0.D0,0.D0,0.D0,0.D0,0.D0, 590 C .04D0,-.78D0, .54D0, .08D0, 0.D0,0.D0,0.D0, 591 D .5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 592 E .04D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 593 F .7D0,-.9D0,-.12D0, 0.D0,0.D0,0.D0,0.D0, 594 G .64D0,-.9D0,-.30D0, .7D0,-.18D0, .2D0, .28D0, 595 H .5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 596 I .04D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 597 J .7D0,-1.08D0, 0.D0,0.D0,0.D0,0.D0,0.D0, 598 K .64D0,-1.26D0,.54D0, .20D0, 0.D0,0.D0,0.D0, 599 L .5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 600 M .04D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 601 N .04D0,-.9D0, .18D0, 0.D0,0.D0,0.D0,0.D0, 602 O .04D0,-.9D0, .18D0, .7D0,-.18D0, .2D0, .16D0/ 603C 604 DATA DT10X/.6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 605 A .5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 606 B .5D0,-.9D0, 0.D0,0.D0,0.D0,0.D0,0.D0, 607 C .5D0,-.9D0,.3D0,.7D0, 0.D0,0.D0,0.D0, 608 D .6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 609 E .5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 610 F .3D0,.1D0 ,.5D0, 0.D0,0.D0,0.D0,0.D0, 611 G .8D0,.1D0 ,-.6D0,.8D0 ,.3D0,-.3D0,.5D0, 612 H .6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 613 I .5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 614 J -.9D0,.1D0,.5D0, 0.D0,0.D0,0.D0,0.D0, 615 K .7D0, .1D0,.3D0, .8D0,-.9D0,-.3D0,.5D0, 616 L .6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 617 M .5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 618 N .5D0,.3D0, 0.D0,0.D0,0.D0,0.D0,0.D0, 619 O .5D0,.3D0,-.6D0,.8D0, 0.D0,0.D0,0.D0/ 620C 621 DATA DT10Y/.5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 622 A .6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 623 B .6D0,.1D0, 0.D0,0.D0,0.D0,0.D0,0.D0, 624 C .6D0,.1D0,-.5D0,.8D0, 0.D0,0.D0,0.D0, 625 D .5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 626 E .6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 627 F -.5D0,-.9D0,.6D0, 0.D0,0.D0,0.D0,0.D0, 628 G -.4D0,-.9D0,.9D0, .7D0,-.5D0, .2D0,.6D0, 629 H .5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 630 I .6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 631 J -.5D0,.6D0, 0.D0,0.D0,0.D0,0.D0,0.D0, 632 K -.4D0,.9D0,-.5D0,.6D0, 0.D0,0.D0,0.D0, 633 L .5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 634 M .6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 635 N .6D0,-.9D0,.1D0, 0.D0,0.D0,0.D0,0.D0, 636 O .6D0,-.9D0,.1D0, .7D0,-.5D0, .2D0, .8D0/ 637C 638 DATA CT10X/ 639 A(.7,-.8),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.), 640 B(.6,-.6),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.), 641 C(.6,-.6),(-.9,.5),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.), 642 D(.6,-.6),(-.9,.5),(.7,-.6),(.1,-.5),(0.,0.),(0.,0.),(0.,0.), 643 E(.7,-.8),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.), 644 F(.6,-.6),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.), 645 G(.7,-.6),(-.4,-.7),(.6,-.6),(0.,0.),(0.,0.),(0.,0.),(0.,0.), 646 H(.8,-.7),(-.4,-.7),(-.1,-.2),(.2,-.8),(.7,-.6),(.1,.4),(.6,-.6), 647 I(.7,-.8),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.), 648 J(.6,-.6),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.), 649 K(-.9,.5),(-.4,-.7),(.6,-.6),(0.,0.),(0.,0.),(0.,0.),(0.,0.), 650 L(.1,-.5),(-.4,-.7),(.7,-.6),(.2,-.8),(-.9,.5),(.1,.4),(.6,-.6), 651 M(.7,-.8),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.), 652 N(.6,-.6),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.), 653 O(.6,-.6),(.7,-.6),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.), 654 P(.6,-.6),(.7,-.6),(-.1,-.2),(.8,-.7),(0.,0.),(0.,0.),(0.,0.) / 655C 656 DATA CT10Y/ 657 A(.6,-.6),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.), 658 B(.7,-.8),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.), 659 C(.7,-.8),(-.4,-.7),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.), 660 D(.7,-.8),(-.4,-.7),(-.1,-.9),(.2,-.8),(0.,0.),(0.,0.),(0.,0.), 661 E(.6,-.6),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.), 662 F(.7,-.8),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.), 663 G(-.1,-.9),(-.9,.5),(.7,-.8),(0.,0.),(0.,0.),(0.,0.),(0.,0.), 664 H(-.6,.6),(-.9,.5),(-.9,-.4),(.1,-.5),(-.1,-.9),(-.5,-.3),(.7,-.8), 665 I(.6,-.6),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.), 666 J(.7,-.8),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.), 667 K(-.1,-.9),(.7,-.8),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.), 668 L(-.6,.6),(-.9,-.4),(-.1,-.9),(.7,-.8),(0.,0.),(0.,0.),(0.,0.), 669 M(.6,-.6),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.), 670 N(.7,-.8),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.), 671 O(.7,-.8),(-.9,.5),(-.4,-.7),(0.,0.),(0.,0.),(0.,0.),(0.,0.), 672 P(.7,-.8),(-.9,.5),(-.4,-.7),(.1,-.5),(-.1,-.9),(-.5,-.3),(.2,-.8)/ 673C TRUE X RESULTS F0R ROTATIONS SROTM AND DROTM 674 DATA DT19XA/.6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 675 A .6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 676 B .6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 677 C .6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 678 D .6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 679 E -.8D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 680 F -.9D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 681 G 3.5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 682 H .6D0, .1D0, 0.D0,0.D0,0.D0,0.D0,0.D0, 683 I -.8D0, 3.8D0, 0.D0,0.D0,0.D0,0.D0,0.D0, 684 J -.9D0, 2.8D0, 0.D0,0.D0,0.D0,0.D0,0.D0, 685 K 3.5D0, -.4D0, 0.D0,0.D0,0.D0,0.D0,0.D0, 686 L .6D0, .1D0, -.5D0, .8D0, 0.D0,0.D0,0.D0, 687 M -.8D0, 3.8D0, -2.2D0, -1.2D0, 0.D0,0.D0,0.D0, 688 N -.9D0, 2.8D0, -1.4D0, -1.3D0, 0.D0,0.D0,0.D0, 689 O 3.5D0, -.4D0, -2.2D0, 4.7D0, 0.D0,0.D0,0.D0/ 690C 691 DATA DT19XB/.6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 692 A .6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 693 B .6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 694 C .6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 695 D .6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 696 E -.8D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 697 F -.9D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 698 G 3.5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 699 H .6D0, .1D0, -.5D0, 0.D0,0.D0,0.D0,0.D0, 700 I 0.D0, .1D0, -3.0D0, 0.D0,0.D0,0.D0,0.D0, 701 J -.3D0, .1D0, -2.0D0, 0.D0,0.D0,0.D0,0.D0, 702 K 3.3D0, .1D0, -2.0D0, 0.D0,0.D0,0.D0,0.D0, 703 L .6D0, .1D0, -.5D0, .8D0, .9D0, -.3D0, -.4D0, 704 M -2.0D0, .1D0, 1.4D0, .8D0, .6D0, -.3D0, -2.8D0, 705 N -1.8D0, .1D0, 1.3D0, .8D0, 0.D0, -.3D0, -1.9D0, 706 O 3.8D0, .1D0, -3.1D0, .8D0, 4.8D0, -.3D0, -1.5D0 / 707C 708 DATA DT19XC/.6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 709 A .6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 710 B .6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 711 C .6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 712 D .6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 713 E -.8D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 714 F -.9D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 715 G 3.5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 716 H .6D0, .1D0, -.5D0, 0.D0,0.D0,0.D0,0.D0, 717 I 4.8D0, .1D0, -3.0D0, 0.D0,0.D0,0.D0,0.D0, 718 J 3.3D0, .1D0, -2.0D0, 0.D0,0.D0,0.D0,0.D0, 719 K 2.1D0, .1D0, -2.0D0, 0.D0,0.D0,0.D0,0.D0, 720 L .6D0, .1D0, -.5D0, .8D0, .9D0, -.3D0, -.4D0, 721 M -1.6D0, .1D0, -2.2D0, .8D0, 5.4D0, -.3D0, -2.8D0, 722 N -1.5D0, .1D0, -1.4D0, .8D0, 3.6D0, -.3D0, -1.9D0, 723 O 3.7D0, .1D0, -2.2D0, .8D0, 3.6D0, -.3D0, -1.5D0 / 724C 725 DATA DT19XD/.6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 726 A .6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 727 B .6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 728 C .6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 729 D .6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 730 E -.8D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 731 F -.9D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 732 G 3.5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 733 H .6D0, .1D0, 0.D0,0.D0,0.D0,0.D0,0.D0, 734 I -.8D0, -1.0D0, 0.D0,0.D0,0.D0,0.D0,0.D0, 735 J -.9D0, -.8D0, 0.D0,0.D0,0.D0,0.D0,0.D0, 736 K 3.5D0, .8D0, 0.D0,0.D0,0.D0,0.D0,0.D0, 737 L .6D0, .1D0, -.5D0, .8D0, 0.D0,0.D0,0.D0, 738 M -.8D0, -1.0D0, 1.4D0, -1.6D0, 0.D0,0.D0,0.D0, 739 N -.9D0, -.8D0, 1.3D0, -1.6D0, 0.D0,0.D0,0.D0, 740 O 3.5D0, .8D0, -3.1D0, 4.8D0, 0.D0,0.D0,0.D0/ 741C TRUE Y RESULTS FOR ROTATIONS SROTM AND DROTM 742 DATA DT19YA/.5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 743 A .5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 744 B .5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 745 C .5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 746 D .5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 747 E .7D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 748 F 1.7D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 749 G -2.6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 750 H .5D0, -.9D0, 0.D0,0.D0,0.D0,0.D0,0.D0, 751 I .7D0, -4.8D0, 0.D0,0.D0,0.D0,0.D0,0.D0, 752 J 1.7D0, -.7D0, 0.D0,0.D0,0.D0,0.D0,0.D0, 753 K -2.6D0, 3.5D0, 0.D0,0.D0,0.D0,0.D0,0.D0, 754 L .5D0, -.9D0, .3D0, .7D0, 0.D0,0.D0,0.D0, 755 M .7D0, -4.8D0, 3.0D0, 1.1D0, 0.D0,0.D0,0.D0, 756 N 1.7D0, -.7D0, -.7D0, 2.3D0, 0.D0,0.D0,0.D0, 757 O -2.6D0, 3.5D0, -.7D0, -3.6D0, 0.D0,0.D0,0.D0/ 758C 759 DATA DT19YB/.5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 760 A .5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 761 B .5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 762 C .5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 763 D .5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 764 E .7D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 765 F 1.7D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 766 G -2.6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 767 H .5D0, -.9D0, .3D0, 0.D0,0.D0,0.D0,0.D0, 768 I 4.0D0, -.9D0, -.3D0, 0.D0,0.D0,0.D0,0.D0, 769 J -.5D0, -.9D0, 1.5D0, 0.D0,0.D0,0.D0,0.D0, 770 K -1.5D0, -.9D0, -1.8D0, 0.D0,0.D0,0.D0,0.D0, 771 L .5D0, -.9D0, .3D0, .7D0, -.6D0, .2D0, .8D0, 772 M 3.7D0, -.9D0, -1.2D0, .7D0, -1.5D0, .2D0, 2.2D0, 773 N -.3D0, -.9D0, 2.1D0, .7D0, -1.6D0, .2D0, 2.0D0, 774 O -1.6D0, -.9D0, -2.1D0, .7D0, 2.9D0, .2D0, -3.8D0 / 775C 776 DATA DT19YC/.5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 777 A .5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 778 B .5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 779 C .5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 780 D .5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 781 E .7D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 782 F 1.7D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 783 G -2.6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 784 H .5D0, -.9D0, 0.D0,0.D0,0.D0,0.D0,0.D0, 785 I 4.0D0, -6.3D0, 0.D0,0.D0,0.D0,0.D0,0.D0, 786 J -.5D0, .3D0, 0.D0,0.D0,0.D0,0.D0,0.D0, 787 K -1.5D0, 3.0D0, 0.D0,0.D0,0.D0,0.D0,0.D0, 788 L .5D0, -.9D0, .3D0, .7D0, 0.D0,0.D0,0.D0, 789 M 3.7D0, -7.2D0, 3.0D0, 1.7D0, 0.D0,0.D0,0.D0, 790 N -.3D0, .9D0, -.7D0, 1.9D0, 0.D0,0.D0,0.D0, 791 O -1.6D0, 2.7D0, -.7D0, -3.4D0, 0.D0,0.D0,0.D0/ 792C 793 DATA DT19YD/.5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 794 A .5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 795 B .5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 796 C .5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 797 D .5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 798 E .7D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 799 F 1.7D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 800 G -2.6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 801 H .5D0, -.9D0, .3D0, 0.D0,0.D0,0.D0,0.D0, 802 I .7D0, -.9D0, 1.2D0, 0.D0,0.D0,0.D0,0.D0, 803 J 1.7D0, -.9D0, .5D0, 0.D0,0.D0,0.D0,0.D0, 804 K -2.6D0, -.9D0, -1.3D0, 0.D0,0.D0,0.D0,0.D0, 805 L .5D0, -.9D0, .3D0, .7D0, -.6D0, .2D0, .8D0, 806 M .7D0, -.9D0, 1.2D0, .7D0, -1.5D0, .2D0, 1.6D0, 807 N 1.7D0, -.9D0, .5D0, .7D0, -1.6D0, .2D0, 2.4D0, 808 O -2.6D0, -.9D0, -1.3D0, .7D0, 2.9D0, .2D0, -4.0D0 / 809C 810 DATA SSIZE1/ 0. , .3 , 1.6 , 3.2 / 811 DATA DSIZE1/ 0.D0, .3D0, 1.6D0, 3.2D0 / 812 DATA SSIZE3/ .1, .4, 1.7, 3.3 / 813C 814C FOR CDOTC AND CDOTU 815C 816 DATA CSIZE1/ (0.,0.), (.9,.9), (1.63,1.73), (2.90,2.78) / 817 DATA SSIZE2/0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0., 818 A 1.17,1.17,1.17,1.17,1.17,1.17,1.17, 819 B 1.17,1.17,1.17,1.17,1.17,1.17,1.17/ 820 DATA DSIZE2/0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 821 A 1.17D0,1.17D0,1.17D0,1.17D0,1.17D0,1.17D0,1.17D0/ 822C 823C FOR CAXPY 824C 825 DATA CSIZE2/ 826 A (0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.), 827 B (1.54,1.54),(1.54,1.54),(1.54,1.54),(1.54,1.54),(1.54,1.54), 828 C (1.54,1.54),(1.54,1.54) / 829C 830C FOR SROTM AND DROTM 831C 832 DATA DPAR/-2.D0, 0.D0,0.D0,0.D0,0.D0, 833 A -1.D0, 2.D0, -3.D0, -4.D0, 5.D0, 834 B 0.D0, 0.D0, 2.D0, -3.D0, 0.D0, 835 C 1.D0, 5.D0, 2.D0, 0.D0, -4.D0/ 836C 837 DO 520 KI = 1, 4 838 INCX = INCXS(KI) 839 INCY = INCYS(KI) 840 MX = IABS(INCX) 841 MY = IABS(INCY) 842C 843 DO 500 KN=1,4 844 N= NS(KN) 845 KSIZE=MIN0(2,KN) 846 LENX = LENS(KN,MX) 847 LENY = LENS(KN,MY) 848C INITIALIZE ALL ARGUMENT ARRAYS. 849 DO 5 I = 1, 7 850 SX(I) = SNGL(DX1(I)) 851 SY(I) = SNGL(DY1(I)) 852 DX(I) = DX1(I) 853 DY(I) = DY1(I) 854 CX(I) = CX1(I) 855 5 CY(I) = CY1(I) 856C 857C BRANCH TO SELECT SUBPROGRAM TO BE TESTED. 858C 859 GO TO ( 10, 20, 30, 40, 50, 60, 70, 80, 90,100, 860 A 110,999,999,140,150,999,999,180,190,200, 861 B 210,220,230,240,250), ICASE 862C 1. SDOT 863 10 CALL STEST(1,SDOT(N,SX,INCX,SY,INCY),SNGL(DT7(KN,KI)), 864 * SSIZE1(KN),SFAC,KPRINT) 865 GO TO 500 866C 2. DSDOT 867 20 CALL STEST(1,SNGL(DSDOT(N,SX,INCX,SY,INCY)), 868 * SNGL(DT7(KN,KI)),SSIZE1(KN),SFAC,KPRINT) 869 GO TO 500 870C 3. SDSDOT 871 30 CALL STEST(1,SDSDOT(N,SB,SX,INCX,SY,INCY), 872 * ST7B(KN,KI),SSIZE3(KN),SFAC,KPRINT) 873 GO TO 500 874C 4. DDOT 875 40 CALL DTEST(1,DDOT(N,DX,INCX,DY,INCY),DT7(KN,KI), 876 * DSIZE1(KN),DFAC,KPRINT) 877 GO TO 500 878C 5. DQDOTI 879 50 CONTINUE 880C DQDOTI AND DQDOTA ARE SUPPOSED TO USE EXTENDED 881C PRECISION ARITHMETIC INTERNALLY. 882C SET MODE = 1 OR 2 TO DISTINGUISH TESTS OF DQDOTI OR DQDOTA 883C IN THE DIAGNOSTIC OUTPUT. 884C 885C MODE = 1 886C CALL DTEST(1,DQDOTI(N,DB,QC,DX2,INCX,DY2,INCY), 887C * DT2(KN,KI,1),DT2(KN,KI,1),DQFAC,KPRINT) 888C GO TO 500 889C 6. DQDOTA 890 60 CONTINUE 891C TO TEST DQDOTA WE ACTUALLY TEST BOTH DQDOTI AND DQDOTA. 892C THE OUTPUT VALUE OF QX FROM DQDOTI WILL BE USED AS INPUT 893C TO DQDOTA. QX IS SUPPOSED TO BE IN A MACHINE-DEPENDENT 894C EXTENDED PRECISION FORM. 895C MODE IS SET TO 1 OR 2 TO DISTINGUISH TESTS OF 896C DQDOTI OR DQDOTA IN THE DIAGNOSTIC OUTPUT. 897C 898C MODE = 1 899C CALL DTEST(1,DQDOTI(N,DB,QC,DX2,INCX,DY2,INCY), 900C * DT2(KN,KI,1),DT2(KN,KI,1),DQFAC,KPRINT) 901C MODE = 2 902C CALL DTEST(1,DQDOTA(N,-DB,QC,DX2,INCX,DY2,INCY), 903C * DT2(KN,KI,2),DT2(KN,KI,2),DQFAC,KPRINT) 904C GO TO 500 905C 7. CDOTC 906 70 CALL STEST(2, CDOTC(N,CX,INCX,CY,INCY), 907 * CT6(KN,KI),CSIZE1(KN),SFAC,KPRINT) 908 GO TO 500 909C 8. CDOTU 910 80 CALL STEST(2,CDOTU(N,CX,INCX,CY,INCY), 911 * CT7(KN,KI),CSIZE1(KN),SFAC,KPRINT) 912 GO TO 500 913C 9. SAXPY 914 90 CALL SAXPY(N,SA,SX,INCX,SY,INCY) 915 DO 95 J = 1, LENY 916 95 STY(J) = SNGL(DT8(J,KN,KI)) 917 CALL STEST(LENY,SY,STY,SSIZE2(1,KSIZE),SFAC,KPRINT) 918 GO TO 500 919C 10. DAXPY 920 100 CALL DAXPY(N,DA,DX,INCX,DY,INCY) 921 CALL DTEST(LENY,DY,DT8(1,KN,KI),DSIZE2(1,KSIZE),DFAC,KPRINT) 922 GO TO 500 923C 11. CAXPY 924 110 CALL CAXPY(N,CA,CX,INCX,CY,INCY) 925 CALL STEST(2*LENY,CY,CT8(1,KN,KI),CSIZE2(1,KSIZE),SFAC,KPRINT) 926 GO TO 500 927C 14. SROT 928 140 CONTINUE 929 DO 144 I = 1, 7 930 SX(I) = SNGL(DX1(I)) 931 SY(I) = SNGL(DY1(I)) 932 STX(I) = SNGL(DT9X(I,KN,KI)) 933 STY(I) = SNGL(DT9Y(I,KN,KI)) 934 144 CONTINUE 935 CALL SROT (N,SX,INCX,SY,INCY,SC,SS) 936 CALL STEST(LENX,SX,STX,SSIZE2(1,KSIZE),SFAC,KPRINT) 937 CALL STEST(LENY,SY,STY,SSIZE2(1,KSIZE),SFAC,KPRINT) 938 GO TO 500 939C 15. DROT 940 150 CONTINUE 941 DO 154 I = 1, 7 942 DX(I) = DX1(I) 943 DY(I) = DY1(I) 944 154 CONTINUE 945 CALL DROT (N,DX,INCX,DY,INCY,DC,DS) 946 CALL DTEST(LENX,DX,DT9X(1,KN,KI),DSIZE2(1,KSIZE),DFAC,KPRINT) 947 CALL DTEST(LENY,DY,DT9Y(1,KN,KI),DSIZE2(1,KSIZE),DFAC,KPRINT) 948 GO TO 500 949C 18. SROTM 950 180 KNI = KN + 4*(KI-1) 951 DO 189 KPAR=1,4 952 DO 182 I = 1, 7 953 SX(I) = SNGL(DX1(I)) 954 SY(I) = SNGL(DY1(I)) 955 STX(I) = SNGL(DT19X(I,KPAR,KNI)) 956 182 STY(I) = SNGL(DT19Y(I,KPAR,KNI)) 957C 958 DO 186 I = 1, 5 959 186 SPARAM(I) = SNGL(DPAR(I,KPAR)) 960C SET MODE TO IDENTIFY DIAGNOSTIC OUTPUT, 961C IF ANY 962 MODE = INT(SPARAM(1)) 963C 964 DO 187 I = 1, LENX 965 187 SSIZE(I) = STX(I) 966C THE TRUE RESULTS DT19X(1,2,7) AND 967C DT19X(5,3,8) ARE ZERO DUE TO CANCELLATION. 968C DT19X(1,2,7) = 2.*.6 - 4.*.3 = 0 969C DT19X(5,3,8) = .9 - 3.*.3 = 0 970C FOR THESE CASES RESPECTIVELY SET SIZE( ) 971C EQUAL TO 2.4 AND 1.8 972 IF ((KPAR .EQ. 2) .AND. (KNI .EQ. 7)) 973 1 SSIZE(1) = 2.4E0 974 IF ((KPAR .EQ. 3) .AND. (KNI .EQ. 8)) 975 1 SSIZE(5) = 1.8E0 976C 977 CALL SROTM(N,SX,INCX,SY,INCY,SPARAM) 978 CALL STEST(LENX,SX,STX,SSIZE,SFAC,KPRINT) 979 CALL STEST(LENY,SY,STY,STY,SFAC,KPRINT) 980 189 CONTINUE 981 GO TO 500 982C 19. DROTM 983 190 KNI = KN + 4*(KI-1) 984 DO 199 KPAR=1,4 985 DO 192 I = 1, 7 986 DX(I) = DX1(I) 987 DY(I) = DY1(I) 988 DTX(I) = DT19X(I,KPAR,KNI) 989 192 DTY(I) = DT19Y(I,KPAR,KNI) 990C 991 DO 196 I = 1, 5 992 196 DPARAM(I) = DPAR(I,KPAR) 993C SET MODE TO IDENTIFY DIAGNOSTIC OUTPUT, 994C IF ANY 995*----------------------------------------------------------------------- 996* Changed by RFB 2-Apr-98 ... f77 compiler on SGI Origin fails on this 997* MODE = IDINT(DPARAM(1)) 998 MODE = INT(DPARAM(1)) 999*----------------------------------------------------------------------- 1000C 1001 DO 197 I = 1, LENX 1002 197 DSIZE(I) = DTX(I) 1003C SEE REMARK ABOVE ABOUT DT11X(1,2,7) 1004C AND DT11X(5,3,8). 1005 IF ((KPAR .EQ. 2) .AND. (KNI .EQ. 7)) 1006 1 DSIZE(1) = 2.4D0 1007 IF ((KPAR .EQ. 3) .AND. (KNI .EQ. 8)) 1008 1 DSIZE(5) = 1.8D0 1009C 1010 CALL DROTM(N,DX,INCX,DY,INCY,DPARAM) 1011 CALL DTEST(LENX,DX,DTX,DSIZE,DFAC,KPRINT) 1012 CALL DTEST(LENY,DY,DTY,DTY,DFAC,KPRINT) 1013 199 CONTINUE 1014 GO TO 500 1015C 20. SCOPY 1016 200 DO 205 I = 1, 7 1017 205 STY(I) = SNGL(DT10Y( I,KN,KI)) 1018 CALL SCOPY(N,SX,INCX,SY,INCY) 1019 CALL STEST(LENY,SY,STY,SSIZE2(1,1),1.,KPRINT) 1020 GO TO 500 1021C 21. DCOPY 1022 210 CALL DCOPY(N,DX,INCX,DY,INCY) 1023 CALL DTEST(LENY,DY,DT10Y(1,KN,KI),DSIZE2(1,1),1.D0,KPRINT) 1024 GO TO 500 1025C 22. CCOPY 1026 220 CALL CCOPY(N,CX,INCX,CY,INCY) 1027 CALL STEST(2*LENY,CY,CT10Y(1,KN,KI),SSIZE2(1,1),1.,KPRINT) 1028 GO TO 500 1029C 23. SSWAP 1030 230 CALL SSWAP(N,SX,INCX,SY,INCY) 1031 DO 235 I = 1, 7 1032 STX(I) = SNGL(DT10X(I,KN,KI)) 1033 235 STY(I) = SNGL(DT10Y(I,KN,KI)) 1034 CALL STEST(LENX,SX,STX,SSIZE2(1,1),1.,KPRINT) 1035 CALL STEST(LENY,SY,STY,SSIZE2(1,1),1.,KPRINT) 1036 GO TO 500 1037C 24. DSWAP 1038 240 CALL DSWAP(N,DX,INCX,DY,INCY) 1039 CALL DTEST(LENX,DX,DT10X(1,KN,KI),DSIZE2(1,1),1.D0,KPRINT) 1040 CALL DTEST(LENY,DY,DT10Y(1,KN,KI),DSIZE2(1,1),1.D0,KPRINT) 1041 GO TO 500 1042C 25. CSWAP 1043 250 CALL CSWAP(N,CX,INCX,CY,INCY) 1044 CALL STEST(2*LENX,CX,CT10X(1,KN,KI),SSIZE2(1,1),1.,KPRINT) 1045 CALL STEST(2*LENY,CY,CT10Y(1,KN,KI),SSIZE2(1,1),1.,KPRINT) 1046C 1047C 1048C 1049 500 CONTINUE 1050 520 CONTINUE 1051 RETURN 1052C THE FOLLOWING STOP SHOULD NEVER BE REACHED. 1053 999 STOP 1054 END 1055 SUBROUTINE HEADER (KPRINT) 1056C1 ********************************* HEADER ************************* 1057C PRINT HEADER FOR CASE 1058C C. L. LAWSON, JPL, 1974 DEC 12 1059C2 1060 COMMON/COMBLA/NPRINT,ICASE,N,INCX,INCY,MODE,PASS 1061 LOGICAL PASS 1062 DIMENSION L(3,38) 1063C 1064 DATA L(1, 1),L(2, 1),L(3, 1)/2H ,2HSD,2HOT/ 1065 DATA L(1, 2),L(2, 2),L(3, 2)/2H D,2HSD,2HOT/ 1066 DATA L(1, 3),L(2, 3),L(3, 3)/2HSD,2HSD,2HOT/ 1067 DATA L(1, 4),L(2, 4),L(3, 4)/2H ,2HDD,2HOT/ 1068 DATA L(1, 5),L(2, 5),L(3, 5)/2HDQ,2HDO,2HTI/ 1069 DATA L(1, 6),L(2, 6),L(3, 6)/2HDQ,2HDO,2HTA/ 1070 DATA L(1,7),L(2,7),L(3,7)/2H C,2HDO,2HTC/ 1071 DATA L(1, 8),L(2, 8),L(3, 8)/2H C,2HDO,2HTU/ 1072 DATA L(1, 9),L(2, 9),L(3, 9)/2H S,2HAX,2HPY/ 1073 DATA L(1,10),L(2,10),L(3,10)/2H D,2HAX,2HPY/ 1074 DATA L(1,11),L(2,11),L(3,11)/2H C,2HAX,2HPY/ 1075 DATA L(1,12),L(2,12),L(3,12)/2H S,2HRO,2HTG/ 1076 DATA L(1,13),L(2,13),L(3,13)/2H D,2HRO,2HTG/ 1077 DATA L(1,14),L(2,14),L(3,14)/2H ,2HSR,2HOT/ 1078 DATA L(1,15),L(2,15),L(3,15)/2H ,2HDR,2HOT/ 1079 DATA L(1,16),L(2,16),L(3,16)/2HSR,2HOT,2HMG/ 1080 DATA L(1,17),L(2,17),L(3,17)/2HDR,2HOT,2HMG/ 1081 DATA L(1,18),L(2,18),L(3,18)/2H S,2HRO,2HTM/ 1082 DATA L(1,19),L(2,19),L(3,19)/2H D,2HRO,2HTM/ 1083 DATA L(1,20),L(2,20),L(3,20)/2H S,2HCO,2HPY/ 1084 DATA L(1,21),L(2,21),L(3,21)/2H D,2HCO,2HPY/ 1085 DATA L(1,22),L(2,22),L(3,22)/2H C,2HCO,2HPY/ 1086 DATA L(1,23),L(2,23),L(3,23)/2H S,2HSW,2HAP/ 1087 DATA L(1,24),L(2,24),L(3,24)/2H D,2HSW,2HAP/ 1088 DATA L(1,25),L(2,25),L(3,25)/2H C,2HSW,2HAP/ 1089 DATA L(1,26),L(2,26),L(3,26)/2H S,2HNR,2HM2/ 1090 DATA L(1,27),L(2,27),L(3,27)/2H D,2HNR,2HM2/ 1091 DATA L(1,28),L(2,28),L(3,28)/2HSC,2HNR,2HM2/ 1092 DATA L(1,29),L(2,29),L(3,29)/2H S,2HAS,2HUM/ 1093 DATA L(1,30),L(2,30),L(3,30)/2H D,2HAS,2HUM/ 1094 DATA L(1,31),L(2,31),L(3,31)/2HSC,2HAS,2HUM/ 1095 DATA L(1,32),L(2,32),L(3,32)/2H S,2HSC,2HAL/ 1096 DATA L(1,33),L(2,33),L(3,33)/2H D,2HSC,2HAL/ 1097 DATA L(1,34),L(2,34),L(3,34)/2H C,2HSC,2HAL/ 1098 DATA L(1,35),L(2,35),L(3,35)/2HCS,2HSC,2HAL/ 1099 DATA L(1,36),L(2,36),L(3,36)/2HIS,2HAM,2HAX/ 1100 DATA L(1,37),L(2,37),L(3,37)/2HID,2HAM,2HAX/ 1101 DATA L(1,38),L(2,38),L(3,38)/2HIC,2HAM,2HAX/ 1102C 1103 IF (KPRINT.GE.2) WRITE(NPRINT,1000)ICASE,(L(I,ICASE),I = 1, 3) 1104 RETURN 1105C 1106 1000 FORMAT('0TEST OF SUBPROGRAM NO.',I3,2X,3A2) 1107 END 1108 SUBROUTINE DTEST(LEN,DCOMP,DTRUE,DSIZE,DFAC,KPRINT) 1109C1 ********************************* DTEST ************************** 1110C 1111C THIS SUBR COMPARES ARRAYS DCOMP() AND DTRUE() OF LENGTH LEN TO 1112C SEE IF THE TERM BY TERM DIFFERENCES, MULTIPLIED BY DFAC, ARE 1113C NEGLIGIBLE. 1114C 1115C C. L. LAWSON, JPL, 1974 DEC 10 1116C2 1117 COMMON/COMBLA/NPRINT,ICASE,N,INCX,INCY,MODE,PASS 1118 LOGICAL PASS 1119 DOUBLE PRECISION DCOMP(LEN),DTRUE(LEN),DSIZE(LEN),DFAC,DDIFF,DD 1120C 1121 DO 10 I = 1, LEN 1122 DD = DCOMP(I)-DTRUE(I) 1123 IF(DDIFF(DABS(DSIZE(I))+DABS(DFAC*DD),DABS(DSIZE(I))) .EQ. 0.D0) 1124 * GO TO 10 1125C 1126C HERE DCOMP(I) IS NOT CLOSE TO DTRUE(I). 1127C 1128 IF(.NOT. PASS) GO TO 5 1129C PRINT FAIL MESSAGE AND HEADER. 1130 PASS = .FALSE. 1131 IF (KPRINT.LT.2) GO TO 10 1132 WRITE(NPRINT,1000) 1133 WRITE(NPRINT,1001) 1134 5 IF (KPRINT.GE.2) WRITE(NPRINT,1002)ICASE,N,INCX,INCY,MODE,I, 1135 * DCOMP(I),DTRUE(I),DD,DSIZE(I) 1136 10 CONTINUE 1137 RETURN 1138 1000 FORMAT('+',39X,'FAIL') 1139 1001 FORMAT('0CASE N INCX INCY MODE I', 1140 1 29X,'COMP(I)',29X,'TRUE(I)',2X,'DIFFERENCE', 1141 2 5X,'SIZE(I)'/1X) 1142 1002 FORMAT(1X,I4,I3,3I5,I3,2D36.18,2D12.4) 1143 END 1144 SUBROUTINE ITEST(LEN,ICOMP,ITRUE,KPRINT) 1145C1 ********************************* ITEST ************************** 1146C 1147C THIS SUBROUTINE COMPARES THE ARRAYS ICOMP() AND ITRUE() OF 1148C LENGTH LEN FOR EQUALITY. 1149C C. L. LAWSON, JPL, 1974 DEC 10 1150C2 1151 COMMON/COMBLA/NPRINT,ICASE,N,INCX,INCY,MODE,PASS 1152 LOGICAL PASS 1153 INTEGER ICOMP(LEN), ITRUE(LEN) 1154C 1155 DO 10 I = 1, LEN 1156 IF(ICOMP(I) .EQ. ITRUE(I)) GO TO 10 1157C 1158C HERE ICOMP(I) IS NOT EQUAL TO ITRUE(I). 1159C 1160 IF(.NOT. PASS) GO TO 5 1161C PRINT FAIL MESSAGE AND HEADER. 1162 PASS = .FALSE. 1163 IF (KPRINT.LT.2) GO TO 2 1164 WRITE(NPRINT,1000) 1165 WRITE(NPRINT,1001) 1166 2 CONTINUE 1167 5 ID=ICOMP(I)-ITRUE(I) 1168 IF (KPRINT.LT.2) GO TO 10 1169 WRITE(NPRINT,1002) ICASE,N,INCX,INCY,MODE,I,ICOMP(I),ITRUE(I),ID 1170 10 CONTINUE 1171 RETURN 1172 1000 FORMAT('+',39X,'FAIL') 1173 1001 FORMAT('0CASE N INCX INCY MODE I', 1174 1 29X,'COMP(I)',29X,'TRUE(I)',2X,'DIFFERENCE'/1X) 1175 1002 FORMAT(1X,I4,I3,3I5,I3,2I36,I12) 1176 END 1177 SUBROUTINE STEST(LEN,SCOMP,STRUE,SSIZE,SFAC,KPRINT) 1178C1 ********************************* STEST ************************** 1179C 1180C THIS SUBR COMPARES ARRAYS SCOMP() AND STRUE() OF LENGTH LEN TO 1181C SEE IF THE TERM BY TERM DIFFERENCES, MULTIPLIED BY SFAC, ARE 1182C NEGLIGIBLE. 1183C 1184C C. L. LAWSON, JPL, 1974 DEC 10 1185C2 1186 REAL SCOMP(LEN),STRUE(LEN),SSIZE(LEN),SFAC,SDIFF,SD 1187 LOGICAL PASS 1188 COMMON/COMBLA/NPRINT,ICASE,N,INCX,INCY,MODE,PASS 1189C 1190 DO 10 I = 1, LEN 1191 SD = SCOMP(I)-STRUE(I) 1192 IF( SDIFF(ABS(SSIZE(I))+ABS(SFAC*SD), ABS(SSIZE(I))) .EQ. 0.) 1193 * GO TO 10 1194C 1195C HERE SCOMP(I) IS NOT CLOSE TO STRUE(I). 1196C 1197 IF(.NOT. PASS) GO TO 5 1198C PRINT FAIL MESSAGE AND HEADER. 1199 PASS = .FALSE. 1200 IF (KPRINT.LT.2) GO TO 10 1201 WRITE(NPRINT,1000) 1202 WRITE(NPRINT,1001) 1203 PASS = .FALSE. 1204 5 IF (KPRINT.GE.2)WRITE(NPRINT,1002)ICASE,N,INCX,INCY,MODE,I, 1205 * SCOMP(I),STRUE(I),SD,SSIZE(I) 1206 10 CONTINUE 1207 RETURN 1208 1000 FORMAT('+',39X,'FAIL') 1209 1001 FORMAT('0CASE N INCX INCY MODE I', 1210 1 29X,'COMP(I)',29X,'TRUE(I)',2X,'DIFFERENCE', 1211 2 5X,'SIZE(I)'/1X) 1212 1002 FORMAT(1X,I4,I3,3I5,I3,2E36.8,2E12.4) 1213 END 1214 DOUBLE PRECISION FUNCTION DDIFF(DA,DB) 1215C1 ********************************* DDIFF ************************** 1216C COMPUTES DIFFERENCE OF TWO NUMBERS. C. L. LAWSON, JPL 1974 FEB 15 1217C2 1218 DOUBLE PRECISION DA,DB 1219 DDIFF=DA-DB 1220 RETURN 1221 END 1222 FUNCTION SDIFF(SA,SB) 1223C1 ********************************* SDIFF ************************** 1224C COMPUTES DIFFERENCE OF TWO NUMBERS. C. L. LAWSON, JPL 1974 FEB 15 1225C2 1226 SDIFF=SA-SB 1227 RETURN 1228 END 1229