[136] | 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 | *
|
---|
| 45 | 99999 FORMAT (' Complex BLAS Test Program Results',/1X)
|
---|
| 46 | 99998 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 | *
|
---|
| 74 | 99999 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 | *
|
---|
| 570 | 99999 FORMAT (' FAIL')
|
---|
| 571 | 99998 FORMAT (/' CASE N INCX INCY MODE I ',
|
---|
| 572 | + ' COMP(I) TRUE(I) DIFFERENCE',
|
---|
| 573 | + ' SIZE(I)',/1X)
|
---|
| 574 | 99997 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 | *
|
---|
| 676 | 99999 FORMAT (' FAIL')
|
---|
| 677 | 99998 FORMAT (/' CASE N INCX INCY MODE ',
|
---|
| 678 | + ' COMP TRUE DIFFERENCE',
|
---|
| 679 | + /1X)
|
---|
| 680 | 99997 FORMAT (1X,I4,I3,3I5,2I36,I12)
|
---|
| 681 | END
|
---|