1*bf2c3715SXin Li*> \brief \b ZBLAT1 2*bf2c3715SXin Li* 3*bf2c3715SXin Li* =========== DOCUMENTATION =========== 4*bf2c3715SXin Li* 5*bf2c3715SXin Li* Online html documentation available at 6*bf2c3715SXin Li* http://www.netlib.org/lapack/explore-html/ 7*bf2c3715SXin Li* 8*bf2c3715SXin Li* Definition: 9*bf2c3715SXin Li* =========== 10*bf2c3715SXin Li* 11*bf2c3715SXin Li* PROGRAM ZBLAT1 12*bf2c3715SXin Li* 13*bf2c3715SXin Li* 14*bf2c3715SXin Li*> \par Purpose: 15*bf2c3715SXin Li* ============= 16*bf2c3715SXin Li*> 17*bf2c3715SXin Li*> \verbatim 18*bf2c3715SXin Li*> 19*bf2c3715SXin Li*> Test program for the COMPLEX*16 Level 1 BLAS. 20*bf2c3715SXin Li*> 21*bf2c3715SXin Li*> Based upon the original BLAS test routine together with: 22*bf2c3715SXin Li*> F06GAF Example Program Text 23*bf2c3715SXin Li*> \endverbatim 24*bf2c3715SXin Li* 25*bf2c3715SXin Li* Authors: 26*bf2c3715SXin Li* ======== 27*bf2c3715SXin Li* 28*bf2c3715SXin Li*> \author Univ. of Tennessee 29*bf2c3715SXin Li*> \author Univ. of California Berkeley 30*bf2c3715SXin Li*> \author Univ. of Colorado Denver 31*bf2c3715SXin Li*> \author NAG Ltd. 32*bf2c3715SXin Li* 33*bf2c3715SXin Li*> \date April 2012 34*bf2c3715SXin Li* 35*bf2c3715SXin Li*> \ingroup complex16_blas_testing 36*bf2c3715SXin Li* 37*bf2c3715SXin Li* ===================================================================== 38*bf2c3715SXin Li PROGRAM ZBLAT1 39*bf2c3715SXin Li* 40*bf2c3715SXin Li* -- Reference BLAS test routine (version 3.4.1) -- 41*bf2c3715SXin Li* -- Reference BLAS is a software package provided by Univ. of Tennessee, -- 42*bf2c3715SXin Li* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 43*bf2c3715SXin Li* April 2012 44*bf2c3715SXin Li* 45*bf2c3715SXin Li* ===================================================================== 46*bf2c3715SXin Li* 47*bf2c3715SXin Li* .. Parameters .. 48*bf2c3715SXin Li INTEGER NOUT 49*bf2c3715SXin Li PARAMETER (NOUT=6) 50*bf2c3715SXin Li* .. Scalars in Common .. 51*bf2c3715SXin Li INTEGER ICASE, INCX, INCY, MODE, N 52*bf2c3715SXin Li LOGICAL PASS 53*bf2c3715SXin Li* .. Local Scalars .. 54*bf2c3715SXin Li DOUBLE PRECISION SFAC 55*bf2c3715SXin Li INTEGER IC 56*bf2c3715SXin Li* .. External Subroutines .. 57*bf2c3715SXin Li EXTERNAL CHECK1, CHECK2, HEADER 58*bf2c3715SXin Li* .. Common blocks .. 59*bf2c3715SXin Li COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS 60*bf2c3715SXin Li* .. Data statements .. 61*bf2c3715SXin Li DATA SFAC/9.765625D-4/ 62*bf2c3715SXin Li* .. Executable Statements .. 63*bf2c3715SXin Li WRITE (NOUT,99999) 64*bf2c3715SXin Li DO 20 IC = 1, 10 65*bf2c3715SXin Li ICASE = IC 66*bf2c3715SXin Li CALL HEADER 67*bf2c3715SXin Li* 68*bf2c3715SXin Li* Initialize PASS, INCX, INCY, and MODE for a new case. 69*bf2c3715SXin Li* The value 9999 for INCX, INCY or MODE will appear in the 70*bf2c3715SXin Li* detailed output, if any, for cases that do not involve 71*bf2c3715SXin Li* these parameters. 72*bf2c3715SXin Li* 73*bf2c3715SXin Li PASS = .TRUE. 74*bf2c3715SXin Li INCX = 9999 75*bf2c3715SXin Li INCY = 9999 76*bf2c3715SXin Li MODE = 9999 77*bf2c3715SXin Li IF (ICASE.LE.5) THEN 78*bf2c3715SXin Li CALL CHECK2(SFAC) 79*bf2c3715SXin Li ELSE IF (ICASE.GE.6) THEN 80*bf2c3715SXin Li CALL CHECK1(SFAC) 81*bf2c3715SXin Li END IF 82*bf2c3715SXin Li* -- Print 83*bf2c3715SXin Li IF (PASS) WRITE (NOUT,99998) 84*bf2c3715SXin Li 20 CONTINUE 85*bf2c3715SXin Li STOP 86*bf2c3715SXin Li* 87*bf2c3715SXin Li99999 FORMAT (' Complex BLAS Test Program Results',/1X) 88*bf2c3715SXin Li99998 FORMAT (' ----- PASS -----') 89*bf2c3715SXin Li END 90*bf2c3715SXin Li SUBROUTINE HEADER 91*bf2c3715SXin Li* .. Parameters .. 92*bf2c3715SXin Li INTEGER NOUT 93*bf2c3715SXin Li PARAMETER (NOUT=6) 94*bf2c3715SXin Li* .. Scalars in Common .. 95*bf2c3715SXin Li INTEGER ICASE, INCX, INCY, MODE, N 96*bf2c3715SXin Li LOGICAL PASS 97*bf2c3715SXin Li* .. Local Arrays .. 98*bf2c3715SXin Li CHARACTER*6 L(10) 99*bf2c3715SXin Li* .. Common blocks .. 100*bf2c3715SXin Li COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS 101*bf2c3715SXin Li* .. Data statements .. 102*bf2c3715SXin Li DATA L(1)/'ZDOTC '/ 103*bf2c3715SXin Li DATA L(2)/'ZDOTU '/ 104*bf2c3715SXin Li DATA L(3)/'ZAXPY '/ 105*bf2c3715SXin Li DATA L(4)/'ZCOPY '/ 106*bf2c3715SXin Li DATA L(5)/'ZSWAP '/ 107*bf2c3715SXin Li DATA L(6)/'DZNRM2'/ 108*bf2c3715SXin Li DATA L(7)/'DZASUM'/ 109*bf2c3715SXin Li DATA L(8)/'ZSCAL '/ 110*bf2c3715SXin Li DATA L(9)/'ZDSCAL'/ 111*bf2c3715SXin Li DATA L(10)/'IZAMAX'/ 112*bf2c3715SXin Li* .. Executable Statements .. 113*bf2c3715SXin Li WRITE (NOUT,99999) ICASE, L(ICASE) 114*bf2c3715SXin Li RETURN 115*bf2c3715SXin Li* 116*bf2c3715SXin Li99999 FORMAT (/' Test of subprogram number',I3,12X,A6) 117*bf2c3715SXin Li END 118*bf2c3715SXin Li SUBROUTINE CHECK1(SFAC) 119*bf2c3715SXin Li* .. Parameters .. 120*bf2c3715SXin Li INTEGER NOUT 121*bf2c3715SXin Li PARAMETER (NOUT=6) 122*bf2c3715SXin Li* .. Scalar Arguments .. 123*bf2c3715SXin Li DOUBLE PRECISION SFAC 124*bf2c3715SXin Li* .. Scalars in Common .. 125*bf2c3715SXin Li INTEGER ICASE, INCX, INCY, MODE, N 126*bf2c3715SXin Li LOGICAL PASS 127*bf2c3715SXin Li* .. Local Scalars .. 128*bf2c3715SXin Li COMPLEX*16 CA 129*bf2c3715SXin Li DOUBLE PRECISION SA 130*bf2c3715SXin Li INTEGER I, J, LEN, NP1 131*bf2c3715SXin Li* .. Local Arrays .. 132*bf2c3715SXin Li COMPLEX*16 CTRUE5(8,5,2), CTRUE6(8,5,2), CV(8,5,2), CX(8), 133*bf2c3715SXin Li + MWPCS(5), MWPCT(5) 134*bf2c3715SXin Li DOUBLE PRECISION STRUE2(5), STRUE4(5) 135*bf2c3715SXin Li INTEGER ITRUE3(5) 136*bf2c3715SXin Li* .. External Functions .. 137*bf2c3715SXin Li DOUBLE PRECISION DZASUM, DZNRM2 138*bf2c3715SXin Li INTEGER IZAMAX 139*bf2c3715SXin Li EXTERNAL DZASUM, DZNRM2, IZAMAX 140*bf2c3715SXin Li* .. External Subroutines .. 141*bf2c3715SXin Li EXTERNAL ZSCAL, ZDSCAL, CTEST, ITEST1, STEST1 142*bf2c3715SXin Li* .. Intrinsic Functions .. 143*bf2c3715SXin Li INTRINSIC MAX 144*bf2c3715SXin Li* .. Common blocks .. 145*bf2c3715SXin Li COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS 146*bf2c3715SXin Li* .. Data statements .. 147*bf2c3715SXin Li DATA SA, CA/0.3D0, (0.4D0,-0.7D0)/ 148*bf2c3715SXin Li DATA ((CV(I,J,1),I=1,8),J=1,5)/(0.1D0,0.1D0), 149*bf2c3715SXin Li + (1.0D0,2.0D0), (1.0D0,2.0D0), (1.0D0,2.0D0), 150*bf2c3715SXin Li + (1.0D0,2.0D0), (1.0D0,2.0D0), (1.0D0,2.0D0), 151*bf2c3715SXin Li + (1.0D0,2.0D0), (0.3D0,-0.4D0), (3.0D0,4.0D0), 152*bf2c3715SXin Li + (3.0D0,4.0D0), (3.0D0,4.0D0), (3.0D0,4.0D0), 153*bf2c3715SXin Li + (3.0D0,4.0D0), (3.0D0,4.0D0), (3.0D0,4.0D0), 154*bf2c3715SXin Li + (0.1D0,-0.3D0), (0.5D0,-0.1D0), (5.0D0,6.0D0), 155*bf2c3715SXin Li + (5.0D0,6.0D0), (5.0D0,6.0D0), (5.0D0,6.0D0), 156*bf2c3715SXin Li + (5.0D0,6.0D0), (5.0D0,6.0D0), (0.1D0,0.1D0), 157*bf2c3715SXin Li + (-0.6D0,0.1D0), (0.1D0,-0.3D0), (7.0D0,8.0D0), 158*bf2c3715SXin Li + (7.0D0,8.0D0), (7.0D0,8.0D0), (7.0D0,8.0D0), 159*bf2c3715SXin Li + (7.0D0,8.0D0), (0.3D0,0.1D0), (0.5D0,0.0D0), 160*bf2c3715SXin Li + (0.0D0,0.5D0), (0.0D0,0.2D0), (2.0D0,3.0D0), 161*bf2c3715SXin Li + (2.0D0,3.0D0), (2.0D0,3.0D0), (2.0D0,3.0D0)/ 162*bf2c3715SXin Li DATA ((CV(I,J,2),I=1,8),J=1,5)/(0.1D0,0.1D0), 163*bf2c3715SXin Li + (4.0D0,5.0D0), (4.0D0,5.0D0), (4.0D0,5.0D0), 164*bf2c3715SXin Li + (4.0D0,5.0D0), (4.0D0,5.0D0), (4.0D0,5.0D0), 165*bf2c3715SXin Li + (4.0D0,5.0D0), (0.3D0,-0.4D0), (6.0D0,7.0D0), 166*bf2c3715SXin Li + (6.0D0,7.0D0), (6.0D0,7.0D0), (6.0D0,7.0D0), 167*bf2c3715SXin Li + (6.0D0,7.0D0), (6.0D0,7.0D0), (6.0D0,7.0D0), 168*bf2c3715SXin Li + (0.1D0,-0.3D0), (8.0D0,9.0D0), (0.5D0,-0.1D0), 169*bf2c3715SXin Li + (2.0D0,5.0D0), (2.0D0,5.0D0), (2.0D0,5.0D0), 170*bf2c3715SXin Li + (2.0D0,5.0D0), (2.0D0,5.0D0), (0.1D0,0.1D0), 171*bf2c3715SXin Li + (3.0D0,6.0D0), (-0.6D0,0.1D0), (4.0D0,7.0D0), 172*bf2c3715SXin Li + (0.1D0,-0.3D0), (7.0D0,2.0D0), (7.0D0,2.0D0), 173*bf2c3715SXin Li + (7.0D0,2.0D0), (0.3D0,0.1D0), (5.0D0,8.0D0), 174*bf2c3715SXin Li + (0.5D0,0.0D0), (6.0D0,9.0D0), (0.0D0,0.5D0), 175*bf2c3715SXin Li + (8.0D0,3.0D0), (0.0D0,0.2D0), (9.0D0,4.0D0)/ 176*bf2c3715SXin Li DATA STRUE2/0.0D0, 0.5D0, 0.6D0, 0.7D0, 0.8D0/ 177*bf2c3715SXin Li DATA STRUE4/0.0D0, 0.7D0, 1.0D0, 1.3D0, 1.6D0/ 178*bf2c3715SXin Li DATA ((CTRUE5(I,J,1),I=1,8),J=1,5)/(0.1D0,0.1D0), 179*bf2c3715SXin Li + (1.0D0,2.0D0), (1.0D0,2.0D0), (1.0D0,2.0D0), 180*bf2c3715SXin Li + (1.0D0,2.0D0), (1.0D0,2.0D0), (1.0D0,2.0D0), 181*bf2c3715SXin Li + (1.0D0,2.0D0), (-0.16D0,-0.37D0), (3.0D0,4.0D0), 182*bf2c3715SXin Li + (3.0D0,4.0D0), (3.0D0,4.0D0), (3.0D0,4.0D0), 183*bf2c3715SXin Li + (3.0D0,4.0D0), (3.0D0,4.0D0), (3.0D0,4.0D0), 184*bf2c3715SXin Li + (-0.17D0,-0.19D0), (0.13D0,-0.39D0), 185*bf2c3715SXin Li + (5.0D0,6.0D0), (5.0D0,6.0D0), (5.0D0,6.0D0), 186*bf2c3715SXin Li + (5.0D0,6.0D0), (5.0D0,6.0D0), (5.0D0,6.0D0), 187*bf2c3715SXin Li + (0.11D0,-0.03D0), (-0.17D0,0.46D0), 188*bf2c3715SXin Li + (-0.17D0,-0.19D0), (7.0D0,8.0D0), (7.0D0,8.0D0), 189*bf2c3715SXin Li + (7.0D0,8.0D0), (7.0D0,8.0D0), (7.0D0,8.0D0), 190*bf2c3715SXin Li + (0.19D0,-0.17D0), (0.20D0,-0.35D0), 191*bf2c3715SXin Li + (0.35D0,0.20D0), (0.14D0,0.08D0), 192*bf2c3715SXin Li + (2.0D0,3.0D0), (2.0D0,3.0D0), (2.0D0,3.0D0), 193*bf2c3715SXin Li + (2.0D0,3.0D0)/ 194*bf2c3715SXin Li DATA ((CTRUE5(I,J,2),I=1,8),J=1,5)/(0.1D0,0.1D0), 195*bf2c3715SXin Li + (4.0D0,5.0D0), (4.0D0,5.0D0), (4.0D0,5.0D0), 196*bf2c3715SXin Li + (4.0D0,5.0D0), (4.0D0,5.0D0), (4.0D0,5.0D0), 197*bf2c3715SXin Li + (4.0D0,5.0D0), (-0.16D0,-0.37D0), (6.0D0,7.0D0), 198*bf2c3715SXin Li + (6.0D0,7.0D0), (6.0D0,7.0D0), (6.0D0,7.0D0), 199*bf2c3715SXin Li + (6.0D0,7.0D0), (6.0D0,7.0D0), (6.0D0,7.0D0), 200*bf2c3715SXin Li + (-0.17D0,-0.19D0), (8.0D0,9.0D0), 201*bf2c3715SXin Li + (0.13D0,-0.39D0), (2.0D0,5.0D0), (2.0D0,5.0D0), 202*bf2c3715SXin Li + (2.0D0,5.0D0), (2.0D0,5.0D0), (2.0D0,5.0D0), 203*bf2c3715SXin Li + (0.11D0,-0.03D0), (3.0D0,6.0D0), 204*bf2c3715SXin Li + (-0.17D0,0.46D0), (4.0D0,7.0D0), 205*bf2c3715SXin Li + (-0.17D0,-0.19D0), (7.0D0,2.0D0), (7.0D0,2.0D0), 206*bf2c3715SXin Li + (7.0D0,2.0D0), (0.19D0,-0.17D0), (5.0D0,8.0D0), 207*bf2c3715SXin Li + (0.20D0,-0.35D0), (6.0D0,9.0D0), 208*bf2c3715SXin Li + (0.35D0,0.20D0), (8.0D0,3.0D0), 209*bf2c3715SXin Li + (0.14D0,0.08D0), (9.0D0,4.0D0)/ 210*bf2c3715SXin Li DATA ((CTRUE6(I,J,1),I=1,8),J=1,5)/(0.1D0,0.1D0), 211*bf2c3715SXin Li + (1.0D0,2.0D0), (1.0D0,2.0D0), (1.0D0,2.0D0), 212*bf2c3715SXin Li + (1.0D0,2.0D0), (1.0D0,2.0D0), (1.0D0,2.0D0), 213*bf2c3715SXin Li + (1.0D0,2.0D0), (0.09D0,-0.12D0), (3.0D0,4.0D0), 214*bf2c3715SXin Li + (3.0D0,4.0D0), (3.0D0,4.0D0), (3.0D0,4.0D0), 215*bf2c3715SXin Li + (3.0D0,4.0D0), (3.0D0,4.0D0), (3.0D0,4.0D0), 216*bf2c3715SXin Li + (0.03D0,-0.09D0), (0.15D0,-0.03D0), 217*bf2c3715SXin Li + (5.0D0,6.0D0), (5.0D0,6.0D0), (5.0D0,6.0D0), 218*bf2c3715SXin Li + (5.0D0,6.0D0), (5.0D0,6.0D0), (5.0D0,6.0D0), 219*bf2c3715SXin Li + (0.03D0,0.03D0), (-0.18D0,0.03D0), 220*bf2c3715SXin Li + (0.03D0,-0.09D0), (7.0D0,8.0D0), (7.0D0,8.0D0), 221*bf2c3715SXin Li + (7.0D0,8.0D0), (7.0D0,8.0D0), (7.0D0,8.0D0), 222*bf2c3715SXin Li + (0.09D0,0.03D0), (0.15D0,0.00D0), 223*bf2c3715SXin Li + (0.00D0,0.15D0), (0.00D0,0.06D0), (2.0D0,3.0D0), 224*bf2c3715SXin Li + (2.0D0,3.0D0), (2.0D0,3.0D0), (2.0D0,3.0D0)/ 225*bf2c3715SXin Li DATA ((CTRUE6(I,J,2),I=1,8),J=1,5)/(0.1D0,0.1D0), 226*bf2c3715SXin Li + (4.0D0,5.0D0), (4.0D0,5.0D0), (4.0D0,5.0D0), 227*bf2c3715SXin Li + (4.0D0,5.0D0), (4.0D0,5.0D0), (4.0D0,5.0D0), 228*bf2c3715SXin Li + (4.0D0,5.0D0), (0.09D0,-0.12D0), (6.0D0,7.0D0), 229*bf2c3715SXin Li + (6.0D0,7.0D0), (6.0D0,7.0D0), (6.0D0,7.0D0), 230*bf2c3715SXin Li + (6.0D0,7.0D0), (6.0D0,7.0D0), (6.0D0,7.0D0), 231*bf2c3715SXin Li + (0.03D0,-0.09D0), (8.0D0,9.0D0), 232*bf2c3715SXin Li + (0.15D0,-0.03D0), (2.0D0,5.0D0), (2.0D0,5.0D0), 233*bf2c3715SXin Li + (2.0D0,5.0D0), (2.0D0,5.0D0), (2.0D0,5.0D0), 234*bf2c3715SXin Li + (0.03D0,0.03D0), (3.0D0,6.0D0), 235*bf2c3715SXin Li + (-0.18D0,0.03D0), (4.0D0,7.0D0), 236*bf2c3715SXin Li + (0.03D0,-0.09D0), (7.0D0,2.0D0), (7.0D0,2.0D0), 237*bf2c3715SXin Li + (7.0D0,2.0D0), (0.09D0,0.03D0), (5.0D0,8.0D0), 238*bf2c3715SXin Li + (0.15D0,0.00D0), (6.0D0,9.0D0), (0.00D0,0.15D0), 239*bf2c3715SXin Li + (8.0D0,3.0D0), (0.00D0,0.06D0), (9.0D0,4.0D0)/ 240*bf2c3715SXin Li DATA ITRUE3/0, 1, 2, 2, 2/ 241*bf2c3715SXin Li* .. Executable Statements .. 242*bf2c3715SXin Li DO 60 INCX = 1, 2 243*bf2c3715SXin Li DO 40 NP1 = 1, 5 244*bf2c3715SXin Li N = NP1 - 1 245*bf2c3715SXin Li LEN = 2*MAX(N,1) 246*bf2c3715SXin Li* .. Set vector arguments .. 247*bf2c3715SXin Li DO 20 I = 1, LEN 248*bf2c3715SXin Li CX(I) = CV(I,NP1,INCX) 249*bf2c3715SXin Li 20 CONTINUE 250*bf2c3715SXin Li IF (ICASE.EQ.6) THEN 251*bf2c3715SXin Li* .. DZNRM2 .. 252*bf2c3715SXin Li CALL STEST1(DZNRM2(N,CX,INCX),STRUE2(NP1),STRUE2(NP1), 253*bf2c3715SXin Li + SFAC) 254*bf2c3715SXin Li ELSE IF (ICASE.EQ.7) THEN 255*bf2c3715SXin Li* .. DZASUM .. 256*bf2c3715SXin Li CALL STEST1(DZASUM(N,CX,INCX),STRUE4(NP1),STRUE4(NP1), 257*bf2c3715SXin Li + SFAC) 258*bf2c3715SXin Li ELSE IF (ICASE.EQ.8) THEN 259*bf2c3715SXin Li* .. ZSCAL .. 260*bf2c3715SXin Li CALL ZSCAL(N,CA,CX,INCX) 261*bf2c3715SXin Li CALL CTEST(LEN,CX,CTRUE5(1,NP1,INCX),CTRUE5(1,NP1,INCX), 262*bf2c3715SXin Li + SFAC) 263*bf2c3715SXin Li ELSE IF (ICASE.EQ.9) THEN 264*bf2c3715SXin Li* .. ZDSCAL .. 265*bf2c3715SXin Li CALL ZDSCAL(N,SA,CX,INCX) 266*bf2c3715SXin Li CALL CTEST(LEN,CX,CTRUE6(1,NP1,INCX),CTRUE6(1,NP1,INCX), 267*bf2c3715SXin Li + SFAC) 268*bf2c3715SXin Li ELSE IF (ICASE.EQ.10) THEN 269*bf2c3715SXin Li* .. IZAMAX .. 270*bf2c3715SXin Li CALL ITEST1(IZAMAX(N,CX,INCX),ITRUE3(NP1)) 271*bf2c3715SXin Li ELSE 272*bf2c3715SXin Li WRITE (NOUT,*) ' Shouldn''t be here in CHECK1' 273*bf2c3715SXin Li STOP 274*bf2c3715SXin Li END IF 275*bf2c3715SXin Li* 276*bf2c3715SXin Li 40 CONTINUE 277*bf2c3715SXin Li 60 CONTINUE 278*bf2c3715SXin Li* 279*bf2c3715SXin Li INCX = 1 280*bf2c3715SXin Li IF (ICASE.EQ.8) THEN 281*bf2c3715SXin Li* ZSCAL 282*bf2c3715SXin Li* Add a test for alpha equal to zero. 283*bf2c3715SXin Li CA = (0.0D0,0.0D0) 284*bf2c3715SXin Li DO 80 I = 1, 5 285*bf2c3715SXin Li MWPCT(I) = (0.0D0,0.0D0) 286*bf2c3715SXin Li MWPCS(I) = (1.0D0,1.0D0) 287*bf2c3715SXin Li 80 CONTINUE 288*bf2c3715SXin Li CALL ZSCAL(5,CA,CX,INCX) 289*bf2c3715SXin Li CALL CTEST(5,CX,MWPCT,MWPCS,SFAC) 290*bf2c3715SXin Li ELSE IF (ICASE.EQ.9) THEN 291*bf2c3715SXin Li* ZDSCAL 292*bf2c3715SXin Li* Add a test for alpha equal to zero. 293*bf2c3715SXin Li SA = 0.0D0 294*bf2c3715SXin Li DO 100 I = 1, 5 295*bf2c3715SXin Li MWPCT(I) = (0.0D0,0.0D0) 296*bf2c3715SXin Li MWPCS(I) = (1.0D0,1.0D0) 297*bf2c3715SXin Li 100 CONTINUE 298*bf2c3715SXin Li CALL ZDSCAL(5,SA,CX,INCX) 299*bf2c3715SXin Li CALL CTEST(5,CX,MWPCT,MWPCS,SFAC) 300*bf2c3715SXin Li* Add a test for alpha equal to one. 301*bf2c3715SXin Li SA = 1.0D0 302*bf2c3715SXin Li DO 120 I = 1, 5 303*bf2c3715SXin Li MWPCT(I) = CX(I) 304*bf2c3715SXin Li MWPCS(I) = CX(I) 305*bf2c3715SXin Li 120 CONTINUE 306*bf2c3715SXin Li CALL ZDSCAL(5,SA,CX,INCX) 307*bf2c3715SXin Li CALL CTEST(5,CX,MWPCT,MWPCS,SFAC) 308*bf2c3715SXin Li* Add a test for alpha equal to minus one. 309*bf2c3715SXin Li SA = -1.0D0 310*bf2c3715SXin Li DO 140 I = 1, 5 311*bf2c3715SXin Li MWPCT(I) = -CX(I) 312*bf2c3715SXin Li MWPCS(I) = -CX(I) 313*bf2c3715SXin Li 140 CONTINUE 314*bf2c3715SXin Li CALL ZDSCAL(5,SA,CX,INCX) 315*bf2c3715SXin Li CALL CTEST(5,CX,MWPCT,MWPCS,SFAC) 316*bf2c3715SXin Li END IF 317*bf2c3715SXin Li RETURN 318*bf2c3715SXin Li END 319*bf2c3715SXin Li SUBROUTINE CHECK2(SFAC) 320*bf2c3715SXin Li* .. Parameters .. 321*bf2c3715SXin Li INTEGER NOUT 322*bf2c3715SXin Li PARAMETER (NOUT=6) 323*bf2c3715SXin Li* .. Scalar Arguments .. 324*bf2c3715SXin Li DOUBLE PRECISION SFAC 325*bf2c3715SXin Li* .. Scalars in Common .. 326*bf2c3715SXin Li INTEGER ICASE, INCX, INCY, MODE, N 327*bf2c3715SXin Li LOGICAL PASS 328*bf2c3715SXin Li* .. Local Scalars .. 329*bf2c3715SXin Li COMPLEX*16 CA 330*bf2c3715SXin Li INTEGER I, J, KI, KN, KSIZE, LENX, LENY, MX, MY 331*bf2c3715SXin Li* .. Local Arrays .. 332*bf2c3715SXin Li COMPLEX*16 CDOT(1), CSIZE1(4), CSIZE2(7,2), CSIZE3(14), 333*bf2c3715SXin Li + CT10X(7,4,4), CT10Y(7,4,4), CT6(4,4), CT7(4,4), 334*bf2c3715SXin Li + CT8(7,4,4), CX(7), CX1(7), CY(7), CY1(7) 335*bf2c3715SXin Li INTEGER INCXS(4), INCYS(4), LENS(4,2), NS(4) 336*bf2c3715SXin Li* .. External Functions .. 337*bf2c3715SXin Li COMPLEX*16 ZDOTC, ZDOTU 338*bf2c3715SXin Li EXTERNAL ZDOTC, ZDOTU 339*bf2c3715SXin Li* .. External Subroutines .. 340*bf2c3715SXin Li EXTERNAL ZAXPY, ZCOPY, ZSWAP, CTEST 341*bf2c3715SXin Li* .. Intrinsic Functions .. 342*bf2c3715SXin Li INTRINSIC ABS, MIN 343*bf2c3715SXin Li* .. Common blocks .. 344*bf2c3715SXin Li COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS 345*bf2c3715SXin Li* .. Data statements .. 346*bf2c3715SXin Li DATA CA/(0.4D0,-0.7D0)/ 347*bf2c3715SXin Li DATA INCXS/1, 2, -2, -1/ 348*bf2c3715SXin Li DATA INCYS/1, -2, 1, -2/ 349*bf2c3715SXin Li DATA LENS/1, 1, 2, 4, 1, 1, 3, 7/ 350*bf2c3715SXin Li DATA NS/0, 1, 2, 4/ 351*bf2c3715SXin Li DATA CX1/(0.7D0,-0.8D0), (-0.4D0,-0.7D0), 352*bf2c3715SXin Li + (-0.1D0,-0.9D0), (0.2D0,-0.8D0), 353*bf2c3715SXin Li + (-0.9D0,-0.4D0), (0.1D0,0.4D0), (-0.6D0,0.6D0)/ 354*bf2c3715SXin Li DATA CY1/(0.6D0,-0.6D0), (-0.9D0,0.5D0), 355*bf2c3715SXin Li + (0.7D0,-0.6D0), (0.1D0,-0.5D0), (-0.1D0,-0.2D0), 356*bf2c3715SXin Li + (-0.5D0,-0.3D0), (0.8D0,-0.7D0)/ 357*bf2c3715SXin Li DATA ((CT8(I,J,1),I=1,7),J=1,4)/(0.6D0,-0.6D0), 358*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 359*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 360*bf2c3715SXin Li + (0.32D0,-1.41D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 361*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 362*bf2c3715SXin Li + (0.0D0,0.0D0), (0.32D0,-1.41D0), 363*bf2c3715SXin Li + (-1.55D0,0.5D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 364*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 365*bf2c3715SXin Li + (0.32D0,-1.41D0), (-1.55D0,0.5D0), 366*bf2c3715SXin Li + (0.03D0,-0.89D0), (-0.38D0,-0.96D0), 367*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0)/ 368*bf2c3715SXin Li DATA ((CT8(I,J,2),I=1,7),J=1,4)/(0.6D0,-0.6D0), 369*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 370*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 371*bf2c3715SXin Li + (0.32D0,-1.41D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 372*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 373*bf2c3715SXin Li + (0.0D0,0.0D0), (-0.07D0,-0.89D0), 374*bf2c3715SXin Li + (-0.9D0,0.5D0), (0.42D0,-1.41D0), (0.0D0,0.0D0), 375*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 376*bf2c3715SXin Li + (0.78D0,0.06D0), (-0.9D0,0.5D0), 377*bf2c3715SXin Li + (0.06D0,-0.13D0), (0.1D0,-0.5D0), 378*bf2c3715SXin Li + (-0.77D0,-0.49D0), (-0.5D0,-0.3D0), 379*bf2c3715SXin Li + (0.52D0,-1.51D0)/ 380*bf2c3715SXin Li DATA ((CT8(I,J,3),I=1,7),J=1,4)/(0.6D0,-0.6D0), 381*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 382*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 383*bf2c3715SXin Li + (0.32D0,-1.41D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 384*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 385*bf2c3715SXin Li + (0.0D0,0.0D0), (-0.07D0,-0.89D0), 386*bf2c3715SXin Li + (-1.18D0,-0.31D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 387*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 388*bf2c3715SXin Li + (0.78D0,0.06D0), (-1.54D0,0.97D0), 389*bf2c3715SXin Li + (0.03D0,-0.89D0), (-0.18D0,-1.31D0), 390*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0)/ 391*bf2c3715SXin Li DATA ((CT8(I,J,4),I=1,7),J=1,4)/(0.6D0,-0.6D0), 392*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 393*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 394*bf2c3715SXin Li + (0.32D0,-1.41D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 395*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 396*bf2c3715SXin Li + (0.0D0,0.0D0), (0.32D0,-1.41D0), (-0.9D0,0.5D0), 397*bf2c3715SXin Li + (0.05D0,-0.6D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 398*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.32D0,-1.41D0), 399*bf2c3715SXin Li + (-0.9D0,0.5D0), (0.05D0,-0.6D0), (0.1D0,-0.5D0), 400*bf2c3715SXin Li + (-0.77D0,-0.49D0), (-0.5D0,-0.3D0), 401*bf2c3715SXin Li + (0.32D0,-1.16D0)/ 402*bf2c3715SXin Li DATA CT7/(0.0D0,0.0D0), (-0.06D0,-0.90D0), 403*bf2c3715SXin Li + (0.65D0,-0.47D0), (-0.34D0,-1.22D0), 404*bf2c3715SXin Li + (0.0D0,0.0D0), (-0.06D0,-0.90D0), 405*bf2c3715SXin Li + (-0.59D0,-1.46D0), (-1.04D0,-0.04D0), 406*bf2c3715SXin Li + (0.0D0,0.0D0), (-0.06D0,-0.90D0), 407*bf2c3715SXin Li + (-0.83D0,0.59D0), (0.07D0,-0.37D0), 408*bf2c3715SXin Li + (0.0D0,0.0D0), (-0.06D0,-0.90D0), 409*bf2c3715SXin Li + (-0.76D0,-1.15D0), (-1.33D0,-1.82D0)/ 410*bf2c3715SXin Li DATA CT6/(0.0D0,0.0D0), (0.90D0,0.06D0), 411*bf2c3715SXin Li + (0.91D0,-0.77D0), (1.80D0,-0.10D0), 412*bf2c3715SXin Li + (0.0D0,0.0D0), (0.90D0,0.06D0), (1.45D0,0.74D0), 413*bf2c3715SXin Li + (0.20D0,0.90D0), (0.0D0,0.0D0), (0.90D0,0.06D0), 414*bf2c3715SXin Li + (-0.55D0,0.23D0), (0.83D0,-0.39D0), 415*bf2c3715SXin Li + (0.0D0,0.0D0), (0.90D0,0.06D0), (1.04D0,0.79D0), 416*bf2c3715SXin Li + (1.95D0,1.22D0)/ 417*bf2c3715SXin Li DATA ((CT10X(I,J,1),I=1,7),J=1,4)/(0.7D0,-0.8D0), 418*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 419*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 420*bf2c3715SXin Li + (0.6D0,-0.6D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 421*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 422*bf2c3715SXin Li + (0.0D0,0.0D0), (0.6D0,-0.6D0), (-0.9D0,0.5D0), 423*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 424*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.6D0,-0.6D0), 425*bf2c3715SXin Li + (-0.9D0,0.5D0), (0.7D0,-0.6D0), (0.1D0,-0.5D0), 426*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0)/ 427*bf2c3715SXin Li DATA ((CT10X(I,J,2),I=1,7),J=1,4)/(0.7D0,-0.8D0), 428*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 429*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 430*bf2c3715SXin Li + (0.6D0,-0.6D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 431*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 432*bf2c3715SXin Li + (0.0D0,0.0D0), (0.7D0,-0.6D0), (-0.4D0,-0.7D0), 433*bf2c3715SXin Li + (0.6D0,-0.6D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 434*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.8D0,-0.7D0), 435*bf2c3715SXin Li + (-0.4D0,-0.7D0), (-0.1D0,-0.2D0), 436*bf2c3715SXin Li + (0.2D0,-0.8D0), (0.7D0,-0.6D0), (0.1D0,0.4D0), 437*bf2c3715SXin Li + (0.6D0,-0.6D0)/ 438*bf2c3715SXin Li DATA ((CT10X(I,J,3),I=1,7),J=1,4)/(0.7D0,-0.8D0), 439*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 440*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 441*bf2c3715SXin Li + (0.6D0,-0.6D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 442*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 443*bf2c3715SXin Li + (0.0D0,0.0D0), (-0.9D0,0.5D0), (-0.4D0,-0.7D0), 444*bf2c3715SXin Li + (0.6D0,-0.6D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 445*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.1D0,-0.5D0), 446*bf2c3715SXin Li + (-0.4D0,-0.7D0), (0.7D0,-0.6D0), (0.2D0,-0.8D0), 447*bf2c3715SXin Li + (-0.9D0,0.5D0), (0.1D0,0.4D0), (0.6D0,-0.6D0)/ 448*bf2c3715SXin Li DATA ((CT10X(I,J,4),I=1,7),J=1,4)/(0.7D0,-0.8D0), 449*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 450*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 451*bf2c3715SXin Li + (0.6D0,-0.6D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 452*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 453*bf2c3715SXin Li + (0.0D0,0.0D0), (0.6D0,-0.6D0), (0.7D0,-0.6D0), 454*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 455*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.6D0,-0.6D0), 456*bf2c3715SXin Li + (0.7D0,-0.6D0), (-0.1D0,-0.2D0), (0.8D0,-0.7D0), 457*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0)/ 458*bf2c3715SXin Li DATA ((CT10Y(I,J,1),I=1,7),J=1,4)/(0.6D0,-0.6D0), 459*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 460*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 461*bf2c3715SXin Li + (0.7D0,-0.8D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 462*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 463*bf2c3715SXin Li + (0.0D0,0.0D0), (0.7D0,-0.8D0), (-0.4D0,-0.7D0), 464*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 465*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.7D0,-0.8D0), 466*bf2c3715SXin Li + (-0.4D0,-0.7D0), (-0.1D0,-0.9D0), 467*bf2c3715SXin Li + (0.2D0,-0.8D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 468*bf2c3715SXin Li + (0.0D0,0.0D0)/ 469*bf2c3715SXin Li DATA ((CT10Y(I,J,2),I=1,7),J=1,4)/(0.6D0,-0.6D0), 470*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 471*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 472*bf2c3715SXin Li + (0.7D0,-0.8D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 473*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 474*bf2c3715SXin Li + (0.0D0,0.0D0), (-0.1D0,-0.9D0), (-0.9D0,0.5D0), 475*bf2c3715SXin Li + (0.7D0,-0.8D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 476*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (-0.6D0,0.6D0), 477*bf2c3715SXin Li + (-0.9D0,0.5D0), (-0.9D0,-0.4D0), (0.1D0,-0.5D0), 478*bf2c3715SXin Li + (-0.1D0,-0.9D0), (-0.5D0,-0.3D0), 479*bf2c3715SXin Li + (0.7D0,-0.8D0)/ 480*bf2c3715SXin Li DATA ((CT10Y(I,J,3),I=1,7),J=1,4)/(0.6D0,-0.6D0), 481*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 482*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 483*bf2c3715SXin Li + (0.7D0,-0.8D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 484*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 485*bf2c3715SXin Li + (0.0D0,0.0D0), (-0.1D0,-0.9D0), (0.7D0,-0.8D0), 486*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 487*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (-0.6D0,0.6D0), 488*bf2c3715SXin Li + (-0.9D0,-0.4D0), (-0.1D0,-0.9D0), 489*bf2c3715SXin Li + (0.7D0,-0.8D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 490*bf2c3715SXin Li + (0.0D0,0.0D0)/ 491*bf2c3715SXin Li DATA ((CT10Y(I,J,4),I=1,7),J=1,4)/(0.6D0,-0.6D0), 492*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 493*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 494*bf2c3715SXin Li + (0.7D0,-0.8D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 495*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 496*bf2c3715SXin Li + (0.0D0,0.0D0), (0.7D0,-0.8D0), (-0.9D0,0.5D0), 497*bf2c3715SXin Li + (-0.4D0,-0.7D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 498*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.7D0,-0.8D0), 499*bf2c3715SXin Li + (-0.9D0,0.5D0), (-0.4D0,-0.7D0), (0.1D0,-0.5D0), 500*bf2c3715SXin Li + (-0.1D0,-0.9D0), (-0.5D0,-0.3D0), 501*bf2c3715SXin Li + (0.2D0,-0.8D0)/ 502*bf2c3715SXin Li DATA CSIZE1/(0.0D0,0.0D0), (0.9D0,0.9D0), 503*bf2c3715SXin Li + (1.63D0,1.73D0), (2.90D0,2.78D0)/ 504*bf2c3715SXin Li DATA CSIZE3/(0.0D0,0.0D0), (0.0D0,0.0D0), 505*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 506*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (1.17D0,1.17D0), 507*bf2c3715SXin Li + (1.17D0,1.17D0), (1.17D0,1.17D0), 508*bf2c3715SXin Li + (1.17D0,1.17D0), (1.17D0,1.17D0), 509*bf2c3715SXin Li + (1.17D0,1.17D0), (1.17D0,1.17D0)/ 510*bf2c3715SXin Li DATA CSIZE2/(0.0D0,0.0D0), (0.0D0,0.0D0), 511*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), 512*bf2c3715SXin Li + (0.0D0,0.0D0), (0.0D0,0.0D0), (1.54D0,1.54D0), 513*bf2c3715SXin Li + (1.54D0,1.54D0), (1.54D0,1.54D0), 514*bf2c3715SXin Li + (1.54D0,1.54D0), (1.54D0,1.54D0), 515*bf2c3715SXin Li + (1.54D0,1.54D0), (1.54D0,1.54D0)/ 516*bf2c3715SXin Li* .. Executable Statements .. 517*bf2c3715SXin Li DO 60 KI = 1, 4 518*bf2c3715SXin Li INCX = INCXS(KI) 519*bf2c3715SXin Li INCY = INCYS(KI) 520*bf2c3715SXin Li MX = ABS(INCX) 521*bf2c3715SXin Li MY = ABS(INCY) 522*bf2c3715SXin Li* 523*bf2c3715SXin Li DO 40 KN = 1, 4 524*bf2c3715SXin Li N = NS(KN) 525*bf2c3715SXin Li KSIZE = MIN(2,KN) 526*bf2c3715SXin Li LENX = LENS(KN,MX) 527*bf2c3715SXin Li LENY = LENS(KN,MY) 528*bf2c3715SXin Li* .. initialize all argument arrays .. 529*bf2c3715SXin Li DO 20 I = 1, 7 530*bf2c3715SXin Li CX(I) = CX1(I) 531*bf2c3715SXin Li CY(I) = CY1(I) 532*bf2c3715SXin Li 20 CONTINUE 533*bf2c3715SXin Li IF (ICASE.EQ.1) THEN 534*bf2c3715SXin Li* .. ZDOTC .. 535*bf2c3715SXin Li CDOT(1) = ZDOTC(N,CX,INCX,CY,INCY) 536*bf2c3715SXin Li CALL CTEST(1,CDOT,CT6(KN,KI),CSIZE1(KN),SFAC) 537*bf2c3715SXin Li ELSE IF (ICASE.EQ.2) THEN 538*bf2c3715SXin Li* .. ZDOTU .. 539*bf2c3715SXin Li CDOT(1) = ZDOTU(N,CX,INCX,CY,INCY) 540*bf2c3715SXin Li CALL CTEST(1,CDOT,CT7(KN,KI),CSIZE1(KN),SFAC) 541*bf2c3715SXin Li ELSE IF (ICASE.EQ.3) THEN 542*bf2c3715SXin Li* .. ZAXPY .. 543*bf2c3715SXin Li CALL ZAXPY(N,CA,CX,INCX,CY,INCY) 544*bf2c3715SXin Li CALL CTEST(LENY,CY,CT8(1,KN,KI),CSIZE2(1,KSIZE),SFAC) 545*bf2c3715SXin Li ELSE IF (ICASE.EQ.4) THEN 546*bf2c3715SXin Li* .. ZCOPY .. 547*bf2c3715SXin Li CALL ZCOPY(N,CX,INCX,CY,INCY) 548*bf2c3715SXin Li CALL CTEST(LENY,CY,CT10Y(1,KN,KI),CSIZE3,1.0D0) 549*bf2c3715SXin Li ELSE IF (ICASE.EQ.5) THEN 550*bf2c3715SXin Li* .. ZSWAP .. 551*bf2c3715SXin Li CALL ZSWAP(N,CX,INCX,CY,INCY) 552*bf2c3715SXin Li CALL CTEST(LENX,CX,CT10X(1,KN,KI),CSIZE3,1.0D0) 553*bf2c3715SXin Li CALL CTEST(LENY,CY,CT10Y(1,KN,KI),CSIZE3,1.0D0) 554*bf2c3715SXin Li ELSE 555*bf2c3715SXin Li WRITE (NOUT,*) ' Shouldn''t be here in CHECK2' 556*bf2c3715SXin Li STOP 557*bf2c3715SXin Li END IF 558*bf2c3715SXin Li* 559*bf2c3715SXin Li 40 CONTINUE 560*bf2c3715SXin Li 60 CONTINUE 561*bf2c3715SXin Li RETURN 562*bf2c3715SXin Li END 563*bf2c3715SXin Li SUBROUTINE STEST(LEN,SCOMP,STRUE,SSIZE,SFAC) 564*bf2c3715SXin Li* ********************************* STEST ************************** 565*bf2c3715SXin Li* 566*bf2c3715SXin Li* THIS SUBR COMPARES ARRAYS SCOMP() AND STRUE() OF LENGTH LEN TO 567*bf2c3715SXin Li* SEE IF THE TERM BY TERM DIFFERENCES, MULTIPLIED BY SFAC, ARE 568*bf2c3715SXin Li* NEGLIGIBLE. 569*bf2c3715SXin Li* 570*bf2c3715SXin Li* C. L. LAWSON, JPL, 1974 DEC 10 571*bf2c3715SXin Li* 572*bf2c3715SXin Li* .. Parameters .. 573*bf2c3715SXin Li INTEGER NOUT 574*bf2c3715SXin Li DOUBLE PRECISION ZERO 575*bf2c3715SXin Li PARAMETER (NOUT=6, ZERO=0.0D0) 576*bf2c3715SXin Li* .. Scalar Arguments .. 577*bf2c3715SXin Li DOUBLE PRECISION SFAC 578*bf2c3715SXin Li INTEGER LEN 579*bf2c3715SXin Li* .. Array Arguments .. 580*bf2c3715SXin Li DOUBLE PRECISION SCOMP(LEN), SSIZE(LEN), STRUE(LEN) 581*bf2c3715SXin Li* .. Scalars in Common .. 582*bf2c3715SXin Li INTEGER ICASE, INCX, INCY, MODE, N 583*bf2c3715SXin Li LOGICAL PASS 584*bf2c3715SXin Li* .. Local Scalars .. 585*bf2c3715SXin Li DOUBLE PRECISION SD 586*bf2c3715SXin Li INTEGER I 587*bf2c3715SXin Li* .. External Functions .. 588*bf2c3715SXin Li DOUBLE PRECISION SDIFF 589*bf2c3715SXin Li EXTERNAL SDIFF 590*bf2c3715SXin Li* .. Intrinsic Functions .. 591*bf2c3715SXin Li INTRINSIC ABS 592*bf2c3715SXin Li* .. Common blocks .. 593*bf2c3715SXin Li COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS 594*bf2c3715SXin Li* .. Executable Statements .. 595*bf2c3715SXin Li* 596*bf2c3715SXin Li DO 40 I = 1, LEN 597*bf2c3715SXin Li SD = SCOMP(I) - STRUE(I) 598*bf2c3715SXin Li IF (ABS(SFAC*SD) .LE. ABS(SSIZE(I))*EPSILON(ZERO)) 599*bf2c3715SXin Li + GO TO 40 600*bf2c3715SXin Li* 601*bf2c3715SXin Li* HERE SCOMP(I) IS NOT CLOSE TO STRUE(I). 602*bf2c3715SXin Li* 603*bf2c3715SXin Li IF ( .NOT. PASS) GO TO 20 604*bf2c3715SXin Li* PRINT FAIL MESSAGE AND HEADER. 605*bf2c3715SXin Li PASS = .FALSE. 606*bf2c3715SXin Li WRITE (NOUT,99999) 607*bf2c3715SXin Li WRITE (NOUT,99998) 608*bf2c3715SXin Li 20 WRITE (NOUT,99997) ICASE, N, INCX, INCY, MODE, I, SCOMP(I), 609*bf2c3715SXin Li + STRUE(I), SD, SSIZE(I) 610*bf2c3715SXin Li 40 CONTINUE 611*bf2c3715SXin Li RETURN 612*bf2c3715SXin Li* 613*bf2c3715SXin Li99999 FORMAT (' FAIL') 614*bf2c3715SXin Li99998 FORMAT (/' CASE N INCX INCY MODE I ', 615*bf2c3715SXin Li + ' COMP(I) TRUE(I) DIFFERENCE', 616*bf2c3715SXin Li + ' SIZE(I)',/1X) 617*bf2c3715SXin Li99997 FORMAT (1X,I4,I3,3I5,I3,2D36.8,2D12.4) 618*bf2c3715SXin Li END 619*bf2c3715SXin Li SUBROUTINE STEST1(SCOMP1,STRUE1,SSIZE,SFAC) 620*bf2c3715SXin Li* ************************* STEST1 ***************************** 621*bf2c3715SXin Li* 622*bf2c3715SXin Li* THIS IS AN INTERFACE SUBROUTINE TO ACCOMMODATE THE FORTRAN 623*bf2c3715SXin Li* REQUIREMENT THAT WHEN A DUMMY ARGUMENT IS AN ARRAY, THE 624*bf2c3715SXin Li* ACTUAL ARGUMENT MUST ALSO BE AN ARRAY OR AN ARRAY ELEMENT. 625*bf2c3715SXin Li* 626*bf2c3715SXin Li* C.L. LAWSON, JPL, 1978 DEC 6 627*bf2c3715SXin Li* 628*bf2c3715SXin Li* .. Scalar Arguments .. 629*bf2c3715SXin Li DOUBLE PRECISION SCOMP1, SFAC, STRUE1 630*bf2c3715SXin Li* .. Array Arguments .. 631*bf2c3715SXin Li DOUBLE PRECISION SSIZE(*) 632*bf2c3715SXin Li* .. Local Arrays .. 633*bf2c3715SXin Li DOUBLE PRECISION SCOMP(1), STRUE(1) 634*bf2c3715SXin Li* .. External Subroutines .. 635*bf2c3715SXin Li EXTERNAL STEST 636*bf2c3715SXin Li* .. Executable Statements .. 637*bf2c3715SXin Li* 638*bf2c3715SXin Li SCOMP(1) = SCOMP1 639*bf2c3715SXin Li STRUE(1) = STRUE1 640*bf2c3715SXin Li CALL STEST(1,SCOMP,STRUE,SSIZE,SFAC) 641*bf2c3715SXin Li* 642*bf2c3715SXin Li RETURN 643*bf2c3715SXin Li END 644*bf2c3715SXin Li DOUBLE PRECISION FUNCTION SDIFF(SA,SB) 645*bf2c3715SXin Li* ********************************* SDIFF ************************** 646*bf2c3715SXin Li* COMPUTES DIFFERENCE OF TWO NUMBERS. C. L. LAWSON, JPL 1974 FEB 15 647*bf2c3715SXin Li* 648*bf2c3715SXin Li* .. Scalar Arguments .. 649*bf2c3715SXin Li DOUBLE PRECISION SA, SB 650*bf2c3715SXin Li* .. Executable Statements .. 651*bf2c3715SXin Li SDIFF = SA - SB 652*bf2c3715SXin Li RETURN 653*bf2c3715SXin Li END 654*bf2c3715SXin Li SUBROUTINE CTEST(LEN,CCOMP,CTRUE,CSIZE,SFAC) 655*bf2c3715SXin Li* **************************** CTEST ***************************** 656*bf2c3715SXin Li* 657*bf2c3715SXin Li* C.L. LAWSON, JPL, 1978 DEC 6 658*bf2c3715SXin Li* 659*bf2c3715SXin Li* .. Scalar Arguments .. 660*bf2c3715SXin Li DOUBLE PRECISION SFAC 661*bf2c3715SXin Li INTEGER LEN 662*bf2c3715SXin Li* .. Array Arguments .. 663*bf2c3715SXin Li COMPLEX*16 CCOMP(LEN), CSIZE(LEN), CTRUE(LEN) 664*bf2c3715SXin Li* .. Local Scalars .. 665*bf2c3715SXin Li INTEGER I 666*bf2c3715SXin Li* .. Local Arrays .. 667*bf2c3715SXin Li DOUBLE PRECISION SCOMP(20), SSIZE(20), STRUE(20) 668*bf2c3715SXin Li* .. External Subroutines .. 669*bf2c3715SXin Li EXTERNAL STEST 670*bf2c3715SXin Li* .. Intrinsic Functions .. 671*bf2c3715SXin Li INTRINSIC DIMAG, DBLE 672*bf2c3715SXin Li* .. Executable Statements .. 673*bf2c3715SXin Li DO 20 I = 1, LEN 674*bf2c3715SXin Li SCOMP(2*I-1) = DBLE(CCOMP(I)) 675*bf2c3715SXin Li SCOMP(2*I) = DIMAG(CCOMP(I)) 676*bf2c3715SXin Li STRUE(2*I-1) = DBLE(CTRUE(I)) 677*bf2c3715SXin Li STRUE(2*I) = DIMAG(CTRUE(I)) 678*bf2c3715SXin Li SSIZE(2*I-1) = DBLE(CSIZE(I)) 679*bf2c3715SXin Li SSIZE(2*I) = DIMAG(CSIZE(I)) 680*bf2c3715SXin Li 20 CONTINUE 681*bf2c3715SXin Li* 682*bf2c3715SXin Li CALL STEST(2*LEN,SCOMP,STRUE,SSIZE,SFAC) 683*bf2c3715SXin Li RETURN 684*bf2c3715SXin Li END 685*bf2c3715SXin Li SUBROUTINE ITEST1(ICOMP,ITRUE) 686*bf2c3715SXin Li* ********************************* ITEST1 ************************* 687*bf2c3715SXin Li* 688*bf2c3715SXin Li* THIS SUBROUTINE COMPARES THE VARIABLES ICOMP AND ITRUE FOR 689*bf2c3715SXin Li* EQUALITY. 690*bf2c3715SXin Li* C. L. LAWSON, JPL, 1974 DEC 10 691*bf2c3715SXin Li* 692*bf2c3715SXin Li* .. Parameters .. 693*bf2c3715SXin Li INTEGER NOUT 694*bf2c3715SXin Li PARAMETER (NOUT=6) 695*bf2c3715SXin Li* .. Scalar Arguments .. 696*bf2c3715SXin Li INTEGER ICOMP, ITRUE 697*bf2c3715SXin Li* .. Scalars in Common .. 698*bf2c3715SXin Li INTEGER ICASE, INCX, INCY, MODE, N 699*bf2c3715SXin Li LOGICAL PASS 700*bf2c3715SXin Li* .. Local Scalars .. 701*bf2c3715SXin Li INTEGER ID 702*bf2c3715SXin Li* .. Common blocks .. 703*bf2c3715SXin Li COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS 704*bf2c3715SXin Li* .. Executable Statements .. 705*bf2c3715SXin Li IF (ICOMP.EQ.ITRUE) GO TO 40 706*bf2c3715SXin Li* 707*bf2c3715SXin Li* HERE ICOMP IS NOT EQUAL TO ITRUE. 708*bf2c3715SXin Li* 709*bf2c3715SXin Li IF ( .NOT. PASS) GO TO 20 710*bf2c3715SXin Li* PRINT FAIL MESSAGE AND HEADER. 711*bf2c3715SXin Li PASS = .FALSE. 712*bf2c3715SXin Li WRITE (NOUT,99999) 713*bf2c3715SXin Li WRITE (NOUT,99998) 714*bf2c3715SXin Li 20 ID = ICOMP - ITRUE 715*bf2c3715SXin Li WRITE (NOUT,99997) ICASE, N, INCX, INCY, MODE, ICOMP, ITRUE, ID 716*bf2c3715SXin Li 40 CONTINUE 717*bf2c3715SXin Li RETURN 718*bf2c3715SXin Li* 719*bf2c3715SXin Li99999 FORMAT (' FAIL') 720*bf2c3715SXin Li99998 FORMAT (/' CASE N INCX INCY MODE ', 721*bf2c3715SXin Li + ' COMP TRUE DIFFERENCE', 722*bf2c3715SXin Li + /1X) 723*bf2c3715SXin Li99997 FORMAT (1X,I4,I3,3I5,2I36,I12) 724*bf2c3715SXin Li END 725