00001 PROGRAM DBLAT1
00002
00003
00004
00005
00006 INTEGER NOUT
00007 PARAMETER (NOUT=6)
00008
00009 INTEGER ICASE, INCX, INCY, MODE, N
00010 LOGICAL PASS
00011
00012 DOUBLE PRECISION SFAC
00013 INTEGER IC
00014
00015 EXTERNAL CHECK0, CHECK1, CHECK2, CHECK3, HEADER
00016
00017 COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
00018
00019 DATA SFAC/9.765625D-4/
00020
00021 WRITE (NOUT,99999)
00022 DO 20 IC = 1, 10
00023 ICASE = IC
00024 CALL HEADER
00025
00026
00027
00028
00029
00030
00031 PASS = .TRUE.
00032 INCX = 9999
00033 INCY = 9999
00034 MODE = 9999
00035 IF (ICASE.EQ.3) THEN
00036 CALL CHECK0(SFAC)
00037 ELSE IF (ICASE.EQ.7 .OR. ICASE.EQ.8 .OR. ICASE.EQ.9 .OR.
00038 + ICASE.EQ.10) THEN
00039 CALL CHECK1(SFAC)
00040 ELSE IF (ICASE.EQ.1 .OR. ICASE.EQ.2 .OR. ICASE.EQ.5 .OR.
00041 + ICASE.EQ.6) THEN
00042 CALL CHECK2(SFAC)
00043 ELSE IF (ICASE.EQ.4) THEN
00044 CALL CHECK3(SFAC)
00045 END IF
00046
00047 IF (PASS) WRITE (NOUT,99998)
00048 20 CONTINUE
00049 STOP
00050
00051 99999 FORMAT (' Real BLAS Test Program Results',/1X)
00052 99998 FORMAT (' ----- PASS -----')
00053 END
00054 SUBROUTINE HEADER
00055
00056 INTEGER NOUT
00057 PARAMETER (NOUT=6)
00058
00059 INTEGER ICASE, INCX, INCY, MODE, N
00060 LOGICAL PASS
00061
00062 CHARACTER*6 L(10)
00063
00064 COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
00065
00066 DATA L(1)/' DDOT '/
00067 DATA L(2)/'DAXPY '/
00068 DATA L(3)/'DROTG '/
00069 DATA L(4)/' DROT '/
00070 DATA L(5)/'DCOPY '/
00071 DATA L(6)/'DSWAP '/
00072 DATA L(7)/'DNRM2 '/
00073 DATA L(8)/'DASUM '/
00074 DATA L(9)/'DSCAL '/
00075 DATA L(10)/'IDAMAX'/
00076
00077 WRITE (NOUT,99999) ICASE, L(ICASE)
00078 RETURN
00079
00080 99999 FORMAT (/' Test of subprogram number',I3,12X,A6)
00081 END
00082 SUBROUTINE CHECK0(SFAC)
00083
00084 INTEGER NOUT
00085 PARAMETER (NOUT=6)
00086
00087 DOUBLE PRECISION SFAC
00088
00089 INTEGER ICASE, INCX, INCY, MODE, N
00090 LOGICAL PASS
00091
00092 DOUBLE PRECISION SA, SB, SC, SS
00093 INTEGER K
00094
00095 DOUBLE PRECISION DA1(8), DATRUE(8), DB1(8), DBTRUE(8), DC1(8),
00096 + DS1(8)
00097
00098 EXTERNAL DROTG, STEST1
00099
00100 COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
00101
00102 DATA DA1/0.3D0, 0.4D0, -0.3D0, -0.4D0, -0.3D0, 0.0D0,
00103 + 0.0D0, 1.0D0/
00104 DATA DB1/0.4D0, 0.3D0, 0.4D0, 0.3D0, -0.4D0, 0.0D0,
00105 + 1.0D0, 0.0D0/
00106 DATA DC1/0.6D0, 0.8D0, -0.6D0, 0.8D0, 0.6D0, 1.0D0,
00107 + 0.0D0, 1.0D0/
00108 DATA DS1/0.8D0, 0.6D0, 0.8D0, -0.6D0, 0.8D0, 0.0D0,
00109 + 1.0D0, 0.0D0/
00110 DATA DATRUE/0.5D0, 0.5D0, 0.5D0, -0.5D0, -0.5D0,
00111 + 0.0D0, 1.0D0, 1.0D0/
00112 DATA DBTRUE/0.0D0, 0.6D0, 0.0D0, -0.6D0, 0.0D0,
00113 + 0.0D0, 1.0D0, 0.0D0/
00114
00115
00116
00117
00118
00119 DBTRUE(1) = 1.0D0/0.6D0
00120 DBTRUE(3) = -1.0D0/0.6D0
00121 DBTRUE(5) = 1.0D0/0.6D0
00122
00123 DO 20 K = 1, 8
00124
00125 N = K
00126 IF (ICASE.EQ.3) THEN
00127
00128 IF (K.GT.8) GO TO 40
00129 SA = DA1(K)
00130 SB = DB1(K)
00131 CALL DROTG(SA,SB,SC,SS)
00132 CALL STEST1(SA,DATRUE(K),DATRUE(K),SFAC)
00133 CALL STEST1(SB,DBTRUE(K),DBTRUE(K),SFAC)
00134 CALL STEST1(SC,DC1(K),DC1(K),SFAC)
00135 CALL STEST1(SS,DS1(K),DS1(K),SFAC)
00136 ELSE
00137 WRITE (NOUT,*) ' Shouldn''t be here in CHECK0'
00138 STOP
00139 END IF
00140 20 CONTINUE
00141 40 RETURN
00142 END
00143 SUBROUTINE CHECK1(SFAC)
00144
00145 INTEGER NOUT
00146 PARAMETER (NOUT=6)
00147
00148 DOUBLE PRECISION SFAC
00149
00150 INTEGER ICASE, INCX, INCY, MODE, N
00151 LOGICAL PASS
00152
00153 INTEGER I, LEN, NP1
00154
00155 DOUBLE PRECISION DTRUE1(5), DTRUE3(5), DTRUE5(8,5,2), DV(8,5,2),
00156 + SA(10), STEMP(1), STRUE(8), SX(8)
00157 INTEGER ITRUE2(5)
00158
00159 DOUBLE PRECISION DASUM, DNRM2
00160 INTEGER IDAMAX
00161 EXTERNAL DASUM, DNRM2, IDAMAX
00162
00163 EXTERNAL ITEST1, DSCAL, STEST, STEST1
00164
00165 INTRINSIC MAX
00166
00167 COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
00168
00169 DATA SA/0.3D0, -1.0D0, 0.0D0, 1.0D0, 0.3D0, 0.3D0,
00170 + 0.3D0, 0.3D0, 0.3D0, 0.3D0/
00171 DATA DV/0.1D0, 2.0D0, 2.0D0, 2.0D0, 2.0D0, 2.0D0,
00172 + 2.0D0, 2.0D0, 0.3D0, 3.0D0, 3.0D0, 3.0D0, 3.0D0,
00173 + 3.0D0, 3.0D0, 3.0D0, 0.3D0, -0.4D0, 4.0D0,
00174 + 4.0D0, 4.0D0, 4.0D0, 4.0D0, 4.0D0, 0.2D0,
00175 + -0.6D0, 0.3D0, 5.0D0, 5.0D0, 5.0D0, 5.0D0,
00176 + 5.0D0, 0.1D0, -0.3D0, 0.5D0, -0.1D0, 6.0D0,
00177 + 6.0D0, 6.0D0, 6.0D0, 0.1D0, 8.0D0, 8.0D0, 8.0D0,
00178 + 8.0D0, 8.0D0, 8.0D0, 8.0D0, 0.3D0, 9.0D0, 9.0D0,
00179 + 9.0D0, 9.0D0, 9.0D0, 9.0D0, 9.0D0, 0.3D0, 2.0D0,
00180 + -0.4D0, 2.0D0, 2.0D0, 2.0D0, 2.0D0, 2.0D0,
00181 + 0.2D0, 3.0D0, -0.6D0, 5.0D0, 0.3D0, 2.0D0,
00182 + 2.0D0, 2.0D0, 0.1D0, 4.0D0, -0.3D0, 6.0D0,
00183 + -0.5D0, 7.0D0, -0.1D0, 3.0D0/
00184 DATA DTRUE1/0.0D0, 0.3D0, 0.5D0, 0.7D0, 0.6D0/
00185 DATA DTRUE3/0.0D0, 0.3D0, 0.7D0, 1.1D0, 1.0D0/
00186 DATA DTRUE5/0.10D0, 2.0D0, 2.0D0, 2.0D0, 2.0D0,
00187 + 2.0D0, 2.0D0, 2.0D0, -0.3D0, 3.0D0, 3.0D0,
00188 + 3.0D0, 3.0D0, 3.0D0, 3.0D0, 3.0D0, 0.0D0, 0.0D0,
00189 + 4.0D0, 4.0D0, 4.0D0, 4.0D0, 4.0D0, 4.0D0,
00190 + 0.20D0, -0.60D0, 0.30D0, 5.0D0, 5.0D0, 5.0D0,
00191 + 5.0D0, 5.0D0, 0.03D0, -0.09D0, 0.15D0, -0.03D0,
00192 + 6.0D0, 6.0D0, 6.0D0, 6.0D0, 0.10D0, 8.0D0,
00193 + 8.0D0, 8.0D0, 8.0D0, 8.0D0, 8.0D0, 8.0D0,
00194 + 0.09D0, 9.0D0, 9.0D0, 9.0D0, 9.0D0, 9.0D0,
00195 + 9.0D0, 9.0D0, 0.09D0, 2.0D0, -0.12D0, 2.0D0,
00196 + 2.0D0, 2.0D0, 2.0D0, 2.0D0, 0.06D0, 3.0D0,
00197 + -0.18D0, 5.0D0, 0.09D0, 2.0D0, 2.0D0, 2.0D0,
00198 + 0.03D0, 4.0D0, -0.09D0, 6.0D0, -0.15D0, 7.0D0,
00199 + -0.03D0, 3.0D0/
00200 DATA ITRUE2/0, 1, 2, 2, 3/
00201
00202 DO 80 INCX = 1, 2
00203 DO 60 NP1 = 1, 5
00204 N = NP1 - 1
00205 LEN = 2*MAX(N,1)
00206
00207 DO 20 I = 1, LEN
00208 SX(I) = DV(I,NP1,INCX)
00209 20 CONTINUE
00210
00211 IF (ICASE.EQ.7) THEN
00212
00213 STEMP(1) = DTRUE1(NP1)
00214 CALL STEST1(DNRM2(N,SX,INCX),STEMP(1),STEMP,SFAC)
00215 ELSE IF (ICASE.EQ.8) THEN
00216
00217 STEMP(1) = DTRUE3(NP1)
00218 CALL STEST1(DASUM(N,SX,INCX),STEMP(1),STEMP,SFAC)
00219 ELSE IF (ICASE.EQ.9) THEN
00220
00221 CALL DSCAL(N,SA((INCX-1)*5+NP1),SX,INCX)
00222 DO 40 I = 1, LEN
00223 STRUE(I) = DTRUE5(I,NP1,INCX)
00224 40 CONTINUE
00225 CALL STEST(LEN,SX,STRUE,STRUE,SFAC)
00226 ELSE IF (ICASE.EQ.10) THEN
00227
00228 CALL ITEST1(IDAMAX(N,SX,INCX),ITRUE2(NP1))
00229 ELSE
00230 WRITE (NOUT,*) ' Shouldn''t be here in CHECK1'
00231 STOP
00232 END IF
00233 60 CONTINUE
00234 80 CONTINUE
00235 RETURN
00236 END
00237 SUBROUTINE CHECK2(SFAC)
00238
00239 INTEGER NOUT
00240 PARAMETER (NOUT=6)
00241
00242 DOUBLE PRECISION SFAC
00243
00244 INTEGER ICASE, INCX, INCY, MODE, N
00245 LOGICAL PASS
00246
00247 DOUBLE PRECISION SA
00248 INTEGER I, J, KI, KN, KSIZE, LENX, LENY, MX, MY
00249
00250 DOUBLE PRECISION DT10X(7,4,4), DT10Y(7,4,4), DT7(4,4),
00251 + DT8(7,4,4), DX1(7),
00252 + DY1(7), SSIZE1(4), SSIZE2(14,2), STX(7), STY(7),
00253 + SX(7), SY(7)
00254 INTEGER INCXS(4), INCYS(4), LENS(4,2), NS(4)
00255
00256 DOUBLE PRECISION DDOT
00257 EXTERNAL DDOT
00258
00259 EXTERNAL DAXPY, DCOPY, DSWAP, STEST, STEST1
00260
00261 INTRINSIC ABS, MIN
00262
00263 COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
00264
00265 DATA SA/0.3D0/
00266 DATA INCXS/1, 2, -2, -1/
00267 DATA INCYS/1, -2, 1, -2/
00268 DATA LENS/1, 1, 2, 4, 1, 1, 3, 7/
00269 DATA NS/0, 1, 2, 4/
00270 DATA DX1/0.6D0, 0.1D0, -0.5D0, 0.8D0, 0.9D0, -0.3D0,
00271 + -0.4D0/
00272 DATA DY1/0.5D0, -0.9D0, 0.3D0, 0.7D0, -0.6D0, 0.2D0,
00273 + 0.8D0/
00274 DATA DT7/0.0D0, 0.30D0, 0.21D0, 0.62D0, 0.0D0,
00275 + 0.30D0, -0.07D0, 0.85D0, 0.0D0, 0.30D0, -0.79D0,
00276 + -0.74D0, 0.0D0, 0.30D0, 0.33D0, 1.27D0/
00277 DATA DT8/0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00278 + 0.0D0, 0.68D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00279 + 0.0D0, 0.0D0, 0.68D0, -0.87D0, 0.0D0, 0.0D0,
00280 + 0.0D0, 0.0D0, 0.0D0, 0.68D0, -0.87D0, 0.15D0,
00281 + 0.94D0, 0.0D0, 0.0D0, 0.0D0, 0.5D0, 0.0D0,
00282 + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.68D0,
00283 + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00284 + 0.35D0, -0.9D0, 0.48D0, 0.0D0, 0.0D0, 0.0D0,
00285 + 0.0D0, 0.38D0, -0.9D0, 0.57D0, 0.7D0, -0.75D0,
00286 + 0.2D0, 0.98D0, 0.5D0, 0.0D0, 0.0D0, 0.0D0,
00287 + 0.0D0, 0.0D0, 0.0D0, 0.68D0, 0.0D0, 0.0D0,
00288 + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.35D0, -0.72D0,
00289 + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.38D0,
00290 + -0.63D0, 0.15D0, 0.88D0, 0.0D0, 0.0D0, 0.0D0,
00291 + 0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00292 + 0.68D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00293 + 0.0D0, 0.68D0, -0.9D0, 0.33D0, 0.0D0, 0.0D0,
00294 + 0.0D0, 0.0D0, 0.68D0, -0.9D0, 0.33D0, 0.7D0,
00295 + -0.75D0, 0.2D0, 1.04D0/
00296 DATA DT10X/0.6D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00297 + 0.0D0, 0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00298 + 0.0D0, 0.5D0, -0.9D0, 0.0D0, 0.0D0, 0.0D0,
00299 + 0.0D0, 0.0D0, 0.5D0, -0.9D0, 0.3D0, 0.7D0,
00300 + 0.0D0, 0.0D0, 0.0D0, 0.6D0, 0.0D0, 0.0D0, 0.0D0,
00301 + 0.0D0, 0.0D0, 0.0D0, 0.5D0, 0.0D0, 0.0D0, 0.0D0,
00302 + 0.0D0, 0.0D0, 0.0D0, 0.3D0, 0.1D0, 0.5D0, 0.0D0,
00303 + 0.0D0, 0.0D0, 0.0D0, 0.8D0, 0.1D0, -0.6D0,
00304 + 0.8D0, 0.3D0, -0.3D0, 0.5D0, 0.6D0, 0.0D0,
00305 + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.5D0, 0.0D0,
00306 + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, -0.9D0,
00307 + 0.1D0, 0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.7D0,
00308 + 0.1D0, 0.3D0, 0.8D0, -0.9D0, -0.3D0, 0.5D0,
00309 + 0.6D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00310 + 0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00311 + 0.5D0, 0.3D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00312 + 0.5D0, 0.3D0, -0.6D0, 0.8D0, 0.0D0, 0.0D0,
00313 + 0.0D0/
00314 DATA DT10Y/0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00315 + 0.0D0, 0.6D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00316 + 0.0D0, 0.6D0, 0.1D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00317 + 0.0D0, 0.6D0, 0.1D0, -0.5D0, 0.8D0, 0.0D0,
00318 + 0.0D0, 0.0D0, 0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00319 + 0.0D0, 0.0D0, 0.6D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00320 + 0.0D0, 0.0D0, -0.5D0, -0.9D0, 0.6D0, 0.0D0,
00321 + 0.0D0, 0.0D0, 0.0D0, -0.4D0, -0.9D0, 0.9D0,
00322 + 0.7D0, -0.5D0, 0.2D0, 0.6D0, 0.5D0, 0.0D0,
00323 + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.6D0, 0.0D0,
00324 + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, -0.5D0,
00325 + 0.6D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00326 + -0.4D0, 0.9D0, -0.5D0, 0.6D0, 0.0D0, 0.0D0,
00327 + 0.0D0, 0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00328 + 0.0D0, 0.6D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00329 + 0.0D0, 0.6D0, -0.9D0, 0.1D0, 0.0D0, 0.0D0,
00330 + 0.0D0, 0.0D0, 0.6D0, -0.9D0, 0.1D0, 0.7D0,
00331 + -0.5D0, 0.2D0, 0.8D0/
00332 DATA SSIZE1/0.0D0, 0.3D0, 1.6D0, 3.2D0/
00333 DATA SSIZE2/0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00334 + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00335 + 0.0D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0,
00336 + 1.17D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0,
00337 + 1.17D0, 1.17D0, 1.17D0/
00338
00339
00340 DO 120 KI = 1, 4
00341 INCX = INCXS(KI)
00342 INCY = INCYS(KI)
00343 MX = ABS(INCX)
00344 MY = ABS(INCY)
00345
00346 DO 100 KN = 1, 4
00347 N = NS(KN)
00348 KSIZE = MIN(2,KN)
00349 LENX = LENS(KN,MX)
00350 LENY = LENS(KN,MY)
00351
00352 DO 20 I = 1, 7
00353 SX(I) = DX1(I)
00354 SY(I) = DY1(I)
00355 20 CONTINUE
00356
00357 IF (ICASE.EQ.1) THEN
00358
00359 CALL STEST1(DDOT(N,SX,INCX,SY,INCY),DT7(KN,KI),SSIZE1(KN)
00360 + ,SFAC)
00361 ELSE IF (ICASE.EQ.2) THEN
00362
00363 CALL DAXPY(N,SA,SX,INCX,SY,INCY)
00364 DO 40 J = 1, LENY
00365 STY(J) = DT8(J,KN,KI)
00366 40 CONTINUE
00367 CALL STEST(LENY,SY,STY,SSIZE2(1,KSIZE),SFAC)
00368 ELSE IF (ICASE.EQ.5) THEN
00369
00370 DO 60 I = 1, 7
00371 STY(I) = DT10Y(I,KN,KI)
00372 60 CONTINUE
00373 CALL DCOPY(N,SX,INCX,SY,INCY)
00374 CALL STEST(LENY,SY,STY,SSIZE2(1,1),1.0D0)
00375 ELSE IF (ICASE.EQ.6) THEN
00376
00377 CALL DSWAP(N,SX,INCX,SY,INCY)
00378 DO 80 I = 1, 7
00379 STX(I) = DT10X(I,KN,KI)
00380 STY(I) = DT10Y(I,KN,KI)
00381 80 CONTINUE
00382 CALL STEST(LENX,SX,STX,SSIZE2(1,1),1.0D0)
00383 CALL STEST(LENY,SY,STY,SSIZE2(1,1),1.0D0)
00384 ELSE
00385 WRITE (NOUT,*) ' Shouldn''t be here in CHECK2'
00386 STOP
00387 END IF
00388 100 CONTINUE
00389 120 CONTINUE
00390 RETURN
00391 END
00392 SUBROUTINE CHECK3(SFAC)
00393
00394 INTEGER NOUT
00395 PARAMETER (NOUT=6)
00396
00397 DOUBLE PRECISION SFAC
00398
00399 INTEGER ICASE, INCX, INCY, MODE, N
00400 LOGICAL PASS
00401
00402 DOUBLE PRECISION SC, SS
00403 INTEGER I, K, KI, KN, KSIZE, LENX, LENY, MX, MY
00404
00405 DOUBLE PRECISION COPYX(5), COPYY(5), DT9X(7,4,4), DT9Y(7,4,4),
00406 + DX1(7), DY1(7), MWPC(11), MWPS(11), MWPSTX(5),
00407 + MWPSTY(5), MWPTX(11,5), MWPTY(11,5), MWPX(5),
00408 + MWPY(5), SSIZE2(14,2), STX(7), STY(7), SX(7),
00409 + SY(7)
00410 INTEGER INCXS(4), INCYS(4), LENS(4,2), MWPINX(11),
00411 + MWPINY(11), MWPN(11), NS(4)
00412
00413 EXTERNAL DROT, STEST
00414
00415 INTRINSIC ABS, MIN
00416
00417 COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
00418
00419 DATA INCXS/1, 2, -2, -1/
00420 DATA INCYS/1, -2, 1, -2/
00421 DATA LENS/1, 1, 2, 4, 1, 1, 3, 7/
00422 DATA NS/0, 1, 2, 4/
00423 DATA DX1/0.6D0, 0.1D0, -0.5D0, 0.8D0, 0.9D0, -0.3D0,
00424 + -0.4D0/
00425 DATA DY1/0.5D0, -0.9D0, 0.3D0, 0.7D0, -0.6D0, 0.2D0,
00426 + 0.8D0/
00427 DATA SC, SS/0.8D0, 0.6D0/
00428 DATA DT9X/0.6D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00429 + 0.0D0, 0.78D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00430 + 0.0D0, 0.0D0, 0.78D0, -0.46D0, 0.0D0, 0.0D0,
00431 + 0.0D0, 0.0D0, 0.0D0, 0.78D0, -0.46D0, -0.22D0,
00432 + 1.06D0, 0.0D0, 0.0D0, 0.0D0, 0.6D0, 0.0D0,
00433 + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.78D0,
00434 + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00435 + 0.66D0, 0.1D0, -0.1D0, 0.0D0, 0.0D0, 0.0D0,
00436 + 0.0D0, 0.96D0, 0.1D0, -0.76D0, 0.8D0, 0.90D0,
00437 + -0.3D0, -0.02D0, 0.6D0, 0.0D0, 0.0D0, 0.0D0,
00438 + 0.0D0, 0.0D0, 0.0D0, 0.78D0, 0.0D0, 0.0D0,
00439 + 0.0D0, 0.0D0, 0.0D0, 0.0D0, -0.06D0, 0.1D0,
00440 + -0.1D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.90D0,
00441 + 0.1D0, -0.22D0, 0.8D0, 0.18D0, -0.3D0, -0.02D0,
00442 + 0.6D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00443 + 0.78D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00444 + 0.0D0, 0.78D0, 0.26D0, 0.0D0, 0.0D0, 0.0D0,
00445 + 0.0D0, 0.0D0, 0.78D0, 0.26D0, -0.76D0, 1.12D0,
00446 + 0.0D0, 0.0D0, 0.0D0/
00447 DATA DT9Y/0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00448 + 0.0D0, 0.04D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00449 + 0.0D0, 0.0D0, 0.04D0, -0.78D0, 0.0D0, 0.0D0,
00450 + 0.0D0, 0.0D0, 0.0D0, 0.04D0, -0.78D0, 0.54D0,
00451 + 0.08D0, 0.0D0, 0.0D0, 0.0D0, 0.5D0, 0.0D0,
00452 + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.04D0,
00453 + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.7D0,
00454 + -0.9D0, -0.12D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00455 + 0.64D0, -0.9D0, -0.30D0, 0.7D0, -0.18D0, 0.2D0,
00456 + 0.28D0, 0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00457 + 0.0D0, 0.0D0, 0.04D0, 0.0D0, 0.0D0, 0.0D0,
00458 + 0.0D0, 0.0D0, 0.0D0, 0.7D0, -1.08D0, 0.0D0,
00459 + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.64D0, -1.26D0,
00460 + 0.54D0, 0.20D0, 0.0D0, 0.0D0, 0.0D0, 0.5D0,
00461 + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00462 + 0.04D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00463 + 0.0D0, 0.04D0, -0.9D0, 0.18D0, 0.0D0, 0.0D0,
00464 + 0.0D0, 0.0D0, 0.04D0, -0.9D0, 0.18D0, 0.7D0,
00465 + -0.18D0, 0.2D0, 0.16D0/
00466 DATA SSIZE2/0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00467 + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00468 + 0.0D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0,
00469 + 1.17D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0,
00470 + 1.17D0, 1.17D0, 1.17D0/
00471
00472
00473 DO 60 KI = 1, 4
00474 INCX = INCXS(KI)
00475 INCY = INCYS(KI)
00476 MX = ABS(INCX)
00477 MY = ABS(INCY)
00478
00479 DO 40 KN = 1, 4
00480 N = NS(KN)
00481 KSIZE = MIN(2,KN)
00482 LENX = LENS(KN,MX)
00483 LENY = LENS(KN,MY)
00484
00485 IF (ICASE.EQ.4) THEN
00486
00487 DO 20 I = 1, 7
00488 SX(I) = DX1(I)
00489 SY(I) = DY1(I)
00490 STX(I) = DT9X(I,KN,KI)
00491 STY(I) = DT9Y(I,KN,KI)
00492 20 CONTINUE
00493 CALL DROT(N,SX,INCX,SY,INCY,SC,SS)
00494 CALL STEST(LENX,SX,STX,SSIZE2(1,KSIZE),SFAC)
00495 CALL STEST(LENY,SY,STY,SSIZE2(1,KSIZE),SFAC)
00496 ELSE
00497 WRITE (NOUT,*) ' Shouldn''t be here in CHECK3'
00498 STOP
00499 END IF
00500 40 CONTINUE
00501 60 CONTINUE
00502
00503 MWPC(1) = 1
00504 DO 80 I = 2, 11
00505 MWPC(I) = 0
00506 80 CONTINUE
00507 MWPS(1) = 0
00508 DO 100 I = 2, 6
00509 MWPS(I) = 1
00510 100 CONTINUE
00511 DO 120 I = 7, 11
00512 MWPS(I) = -1
00513 120 CONTINUE
00514 MWPINX(1) = 1
00515 MWPINX(2) = 1
00516 MWPINX(3) = 1
00517 MWPINX(4) = -1
00518 MWPINX(5) = 1
00519 MWPINX(6) = -1
00520 MWPINX(7) = 1
00521 MWPINX(8) = 1
00522 MWPINX(9) = -1
00523 MWPINX(10) = 1
00524 MWPINX(11) = -1
00525 MWPINY(1) = 1
00526 MWPINY(2) = 1
00527 MWPINY(3) = -1
00528 MWPINY(4) = -1
00529 MWPINY(5) = 2
00530 MWPINY(6) = 1
00531 MWPINY(7) = 1
00532 MWPINY(8) = -1
00533 MWPINY(9) = -1
00534 MWPINY(10) = 2
00535 MWPINY(11) = 1
00536 DO 140 I = 1, 11
00537 MWPN(I) = 5
00538 140 CONTINUE
00539 MWPN(5) = 3
00540 MWPN(10) = 3
00541 DO 160 I = 1, 5
00542 MWPX(I) = I
00543 MWPY(I) = I
00544 MWPTX(1,I) = I
00545 MWPTY(1,I) = I
00546 MWPTX(2,I) = I
00547 MWPTY(2,I) = -I
00548 MWPTX(3,I) = 6 - I
00549 MWPTY(3,I) = I - 6
00550 MWPTX(4,I) = I
00551 MWPTY(4,I) = -I
00552 MWPTX(6,I) = 6 - I
00553 MWPTY(6,I) = I - 6
00554 MWPTX(7,I) = -I
00555 MWPTY(7,I) = I
00556 MWPTX(8,I) = I - 6
00557 MWPTY(8,I) = 6 - I
00558 MWPTX(9,I) = -I
00559 MWPTY(9,I) = I
00560 MWPTX(11,I) = I - 6
00561 MWPTY(11,I) = 6 - I
00562 160 CONTINUE
00563 MWPTX(5,1) = 1
00564 MWPTX(5,2) = 3
00565 MWPTX(5,3) = 5
00566 MWPTX(5,4) = 4
00567 MWPTX(5,5) = 5
00568 MWPTY(5,1) = -1
00569 MWPTY(5,2) = 2
00570 MWPTY(5,3) = -2
00571 MWPTY(5,4) = 4
00572 MWPTY(5,5) = -3
00573 MWPTX(10,1) = -1
00574 MWPTX(10,2) = -3
00575 MWPTX(10,3) = -5
00576 MWPTX(10,4) = 4
00577 MWPTX(10,5) = 5
00578 MWPTY(10,1) = 1
00579 MWPTY(10,2) = 2
00580 MWPTY(10,3) = 2
00581 MWPTY(10,4) = 4
00582 MWPTY(10,5) = 3
00583 DO 200 I = 1, 11
00584 INCX = MWPINX(I)
00585 INCY = MWPINY(I)
00586 DO 180 K = 1, 5
00587 COPYX(K) = MWPX(K)
00588 COPYY(K) = MWPY(K)
00589 MWPSTX(K) = MWPTX(I,K)
00590 MWPSTY(K) = MWPTY(I,K)
00591 180 CONTINUE
00592 CALL DROT(MWPN(I),COPYX,INCX,COPYY,INCY,MWPC(I),MWPS(I))
00593 CALL STEST(5,COPYX,MWPSTX,MWPSTX,SFAC)
00594 CALL STEST(5,COPYY,MWPSTY,MWPSTY,SFAC)
00595 200 CONTINUE
00596 RETURN
00597 END
00598 SUBROUTINE STEST(LEN,SCOMP,STRUE,SSIZE,SFAC)
00599
00600
00601
00602
00603
00604
00605
00606
00607
00608 INTEGER NOUT
00609 PARAMETER (NOUT=6)
00610
00611 DOUBLE PRECISION SFAC
00612 INTEGER LEN
00613
00614 DOUBLE PRECISION SCOMP(LEN), SSIZE(LEN), STRUE(LEN)
00615
00616 INTEGER ICASE, INCX, INCY, MODE, N
00617 LOGICAL PASS
00618
00619 DOUBLE PRECISION SD
00620 INTEGER I
00621
00622 DOUBLE PRECISION SDIFF
00623 EXTERNAL SDIFF
00624
00625 INTRINSIC ABS
00626
00627 COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
00628
00629
00630 DO 40 I = 1, LEN
00631 SD = SCOMP(I) - STRUE(I)
00632 IF (SDIFF(ABS(SSIZE(I))+ABS(SFAC*SD),ABS(SSIZE(I))).EQ.0.0D0)
00633 + GO TO 40
00634
00635
00636
00637 IF ( .NOT. PASS) GO TO 20
00638
00639 PASS = .FALSE.
00640 WRITE (NOUT,99999)
00641 WRITE (NOUT,99998)
00642 20 WRITE (NOUT,99997) ICASE, N, INCX, INCY, MODE, I, SCOMP(I),
00643 + STRUE(I), SD, SSIZE(I)
00644 40 CONTINUE
00645 RETURN
00646
00647 99999 FORMAT (' FAIL')
00648 99998 FORMAT (/' CASE N INCX INCY MODE I ',
00649 + ' COMP(I) TRUE(I) DIFFERENCE',
00650 + ' SIZE(I)',/1X)
00651 99997 FORMAT (1X,I4,I3,3I5,I3,2D36.8,2D12.4)
00652 END
00653 SUBROUTINE STEST1(SCOMP1,STRUE1,SSIZE,SFAC)
00654
00655
00656
00657
00658
00659
00660
00661
00662
00663 DOUBLE PRECISION SCOMP1, SFAC, STRUE1
00664
00665 DOUBLE PRECISION SSIZE(*)
00666
00667 DOUBLE PRECISION SCOMP(1), STRUE(1)
00668
00669 EXTERNAL STEST
00670
00671
00672 SCOMP(1) = SCOMP1
00673 STRUE(1) = STRUE1
00674 CALL STEST(1,SCOMP,STRUE,SSIZE,SFAC)
00675
00676 RETURN
00677 END
00678 DOUBLE PRECISION FUNCTION SDIFF(SA,SB)
00679
00680
00681
00682
00683 DOUBLE PRECISION SA, SB
00684
00685 SDIFF = SA - SB
00686 RETURN
00687 END
00688 SUBROUTINE ITEST1(ICOMP,ITRUE)
00689
00690
00691
00692
00693
00694
00695
00696 INTEGER NOUT
00697 PARAMETER (NOUT=6)
00698
00699 INTEGER ICOMP, ITRUE
00700
00701 INTEGER ICASE, INCX, INCY, MODE, N
00702 LOGICAL PASS
00703
00704 INTEGER ID
00705
00706 COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
00707
00708
00709 IF (ICOMP.EQ.ITRUE) GO TO 40
00710
00711
00712
00713 IF ( .NOT. PASS) GO TO 20
00714
00715 PASS = .FALSE.
00716 WRITE (NOUT,99999)
00717 WRITE (NOUT,99998)
00718 20 ID = ICOMP - ITRUE
00719 WRITE (NOUT,99997) ICASE, N, INCX, INCY, MODE, ICOMP, ITRUE, ID
00720 40 CONTINUE
00721 RETURN
00722
00723 99999 FORMAT (' FAIL')
00724 99998 FORMAT (/' CASE N INCX INCY MODE ',
00725 + ' COMP TRUE DIFFERENCE',
00726 + /1X)
00727 99997 FORMAT (1X,I4,I3,3I5,2I36,I12)
00728 END
