1*bf2c3715SXin Li*> \brief \b CBLAT1 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 CBLAT1 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 Level 1 BLAS. 20*bf2c3715SXin Li*> Based upon the original BLAS test routine together with: 21*bf2c3715SXin Li*> 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 complex_blas_testing 36*bf2c3715SXin Li* 37*bf2c3715SXin Li* ===================================================================== 38*bf2c3715SXin Li PROGRAM CBLAT1 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 REAL 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.765625E-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)/'CDOTC '/ 103*bf2c3715SXin Li DATA L(2)/'CDOTU '/ 104*bf2c3715SXin Li DATA L(3)/'CAXPY '/ 105*bf2c3715SXin Li DATA L(4)/'CCOPY '/ 106*bf2c3715SXin Li DATA L(5)/'CSWAP '/ 107*bf2c3715SXin Li DATA L(6)/'SCNRM2'/ 108*bf2c3715SXin Li DATA L(7)/'SCASUM'/ 109*bf2c3715SXin Li DATA L(8)/'CSCAL '/ 110*bf2c3715SXin Li DATA L(9)/'CSSCAL'/ 111*bf2c3715SXin Li DATA L(10)/'ICAMAX'/ 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 REAL 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 CA 129*bf2c3715SXin Li REAL SA 130*bf2c3715SXin Li INTEGER I, J, LEN, NP1 131*bf2c3715SXin Li* .. Local Arrays .. 132*bf2c3715SXin Li COMPLEX CTRUE5(8,5,2), CTRUE6(8,5,2), CV(8,5,2), CX(8), 133*bf2c3715SXin Li + MWPCS(5), MWPCT(5) 134*bf2c3715SXin Li REAL STRUE2(5), STRUE4(5) 135*bf2c3715SXin Li INTEGER ITRUE3(5) 136*bf2c3715SXin Li* .. External Functions .. 137*bf2c3715SXin Li REAL SCASUM, SCNRM2 138*bf2c3715SXin Li INTEGER ICAMAX 139*bf2c3715SXin Li EXTERNAL SCASUM, SCNRM2, ICAMAX 140*bf2c3715SXin Li* .. External Subroutines .. 141*bf2c3715SXin Li EXTERNAL CSCAL, CSSCAL, 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.3E0, (0.4E0,-0.7E0)/ 148*bf2c3715SXin Li DATA ((CV(I,J,1),I=1,8),J=1,5)/(0.1E0,0.1E0), 149*bf2c3715SXin Li + (1.0E0,2.0E0), (1.0E0,2.0E0), (1.0E0,2.0E0), 150*bf2c3715SXin Li + (1.0E0,2.0E0), (1.0E0,2.0E0), (1.0E0,2.0E0), 151*bf2c3715SXin Li + (1.0E0,2.0E0), (0.3E0,-0.4E0), (3.0E0,4.0E0), 152*bf2c3715SXin Li + (3.0E0,4.0E0), (3.0E0,4.0E0), (3.0E0,4.0E0), 153*bf2c3715SXin Li + (3.0E0,4.0E0), (3.0E0,4.0E0), (3.0E0,4.0E0), 154*bf2c3715SXin Li + (0.1E0,-0.3E0), (0.5E0,-0.1E0), (5.0E0,6.0E0), 155*bf2c3715SXin Li + (5.0E0,6.0E0), (5.0E0,6.0E0), (5.0E0,6.0E0), 156*bf2c3715SXin Li + (5.0E0,6.0E0), (5.0E0,6.0E0), (0.1E0,0.1E0), 157*bf2c3715SXin Li + (-0.6E0,0.1E0), (0.1E0,-0.3E0), (7.0E0,8.0E0), 158*bf2c3715SXin Li + (7.0E0,8.0E0), (7.0E0,8.0E0), (7.0E0,8.0E0), 159*bf2c3715SXin Li + (7.0E0,8.0E0), (0.3E0,0.1E0), (0.5E0,0.0E0), 160*bf2c3715SXin Li + (0.0E0,0.5E0), (0.0E0,0.2E0), (2.0E0,3.0E0), 161*bf2c3715SXin Li + (2.0E0,3.0E0), (2.0E0,3.0E0), (2.0E0,3.0E0)/ 162*bf2c3715SXin Li DATA ((CV(I,J,2),I=1,8),J=1,5)/(0.1E0,0.1E0), 163*bf2c3715SXin Li + (4.0E0,5.0E0), (4.0E0,5.0E0), (4.0E0,5.0E0), 164*bf2c3715SXin Li + (4.0E0,5.0E0), (4.0E0,5.0E0), (4.0E0,5.0E0), 165*bf2c3715SXin Li + (4.0E0,5.0E0), (0.3E0,-0.4E0), (6.0E0,7.0E0), 166*bf2c3715SXin Li + (6.0E0,7.0E0), (6.0E0,7.0E0), (6.0E0,7.0E0), 167*bf2c3715SXin Li + (6.0E0,7.0E0), (6.0E0,7.0E0), (6.0E0,7.0E0), 168*bf2c3715SXin Li + (0.1E0,-0.3E0), (8.0E0,9.0E0), (0.5E0,-0.1E0), 169*bf2c3715SXin Li + (2.0E0,5.0E0), (2.0E0,5.0E0), (2.0E0,5.0E0), 170*bf2c3715SXin Li + (2.0E0,5.0E0), (2.0E0,5.0E0), (0.1E0,0.1E0), 171*bf2c3715SXin Li + (3.0E0,6.0E0), (-0.6E0,0.1E0), (4.0E0,7.0E0), 172*bf2c3715SXin Li + (0.1E0,-0.3E0), (7.0E0,2.0E0), (7.0E0,2.0E0), 173*bf2c3715SXin Li + (7.0E0,2.0E0), (0.3E0,0.1E0), (5.0E0,8.0E0), 174*bf2c3715SXin Li + (0.5E0,0.0E0), (6.0E0,9.0E0), (0.0E0,0.5E0), 175*bf2c3715SXin Li + (8.0E0,3.0E0), (0.0E0,0.2E0), (9.0E0,4.0E0)/ 176*bf2c3715SXin Li DATA STRUE2/0.0E0, 0.5E0, 0.6E0, 0.7E0, 0.8E0/ 177*bf2c3715SXin Li DATA STRUE4/0.0E0, 0.7E0, 1.0E0, 1.3E0, 1.6E0/ 178*bf2c3715SXin Li DATA ((CTRUE5(I,J,1),I=1,8),J=1,5)/(0.1E0,0.1E0), 179*bf2c3715SXin Li + (1.0E0,2.0E0), (1.0E0,2.0E0), (1.0E0,2.0E0), 180*bf2c3715SXin Li + (1.0E0,2.0E0), (1.0E0,2.0E0), (1.0E0,2.0E0), 181*bf2c3715SXin Li + (1.0E0,2.0E0), (-0.16E0,-0.37E0), (3.0E0,4.0E0), 182*bf2c3715SXin Li + (3.0E0,4.0E0), (3.0E0,4.0E0), (3.0E0,4.0E0), 183*bf2c3715SXin Li + (3.0E0,4.0E0), (3.0E0,4.0E0), (3.0E0,4.0E0), 184*bf2c3715SXin Li + (-0.17E0,-0.19E0), (0.13E0,-0.39E0), 185*bf2c3715SXin Li + (5.0E0,6.0E0), (5.0E0,6.0E0), (5.0E0,6.0E0), 186*bf2c3715SXin Li + (5.0E0,6.0E0), (5.0E0,6.0E0), (5.0E0,6.0E0), 187*bf2c3715SXin Li + (0.11E0,-0.03E0), (-0.17E0,0.46E0), 188*bf2c3715SXin Li + (-0.17E0,-0.19E0), (7.0E0,8.0E0), (7.0E0,8.0E0), 189*bf2c3715SXin Li + (7.0E0,8.0E0), (7.0E0,8.0E0), (7.0E0,8.0E0), 190*bf2c3715SXin Li + (0.19E0,-0.17E0), (0.20E0,-0.35E0), 191*bf2c3715SXin Li + (0.35E0,0.20E0), (0.14E0,0.08E0), 192*bf2c3715SXin Li + (2.0E0,3.0E0), (2.0E0,3.0E0), (2.0E0,3.0E0), 193*bf2c3715SXin Li + (2.0E0,3.0E0)/ 194*bf2c3715SXin Li DATA ((CTRUE5(I,J,2),I=1,8),J=1,5)/(0.1E0,0.1E0), 195*bf2c3715SXin Li + (4.0E0,5.0E0), (4.0E0,5.0E0), (4.0E0,5.0E0), 196*bf2c3715SXin Li + (4.0E0,5.0E0), (4.0E0,5.0E0), (4.0E0,5.0E0), 197*bf2c3715SXin Li + (4.0E0,5.0E0), (-0.16E0,-0.37E0), (6.0E0,7.0E0), 198*bf2c3715SXin Li + (6.0E0,7.0E0), (6.0E0,7.0E0), (6.0E0,7.0E0), 199*bf2c3715SXin Li + (6.0E0,7.0E0), (6.0E0,7.0E0), (6.0E0,7.0E0), 200*bf2c3715SXin Li + (-0.17E0,-0.19E0), (8.0E0,9.0E0), 201*bf2c3715SXin Li + (0.13E0,-0.39E0), (2.0E0,5.0E0), (2.0E0,5.0E0), 202*bf2c3715SXin Li + (2.0E0,5.0E0), (2.0E0,5.0E0), (2.0E0,5.0E0), 203*bf2c3715SXin Li + (0.11E0,-0.03E0), (3.0E0,6.0E0), 204*bf2c3715SXin Li + (-0.17E0,0.46E0), (4.0E0,7.0E0), 205*bf2c3715SXin Li + (-0.17E0,-0.19E0), (7.0E0,2.0E0), (7.0E0,2.0E0), 206*bf2c3715SXin Li + (7.0E0,2.0E0), (0.19E0,-0.17E0), (5.0E0,8.0E0), 207*bf2c3715SXin Li + (0.20E0,-0.35E0), (6.0E0,9.0E0), 208*bf2c3715SXin Li + (0.35E0,0.20E0), (8.0E0,3.0E0), 209*bf2c3715SXin Li + (0.14E0,0.08E0), (9.0E0,4.0E0)/ 210*bf2c3715SXin Li DATA ((CTRUE6(I,J,1),I=1,8),J=1,5)/(0.1E0,0.1E0), 211*bf2c3715SXin Li + (1.0E0,2.0E0), (1.0E0,2.0E0), (1.0E0,2.0E0), 212*bf2c3715SXin Li + (1.0E0,2.0E0), (1.0E0,2.0E0), (1.0E0,2.0E0), 213*bf2c3715SXin Li + (1.0E0,2.0E0), (0.09E0,-0.12E0), (3.0E0,4.0E0), 214*bf2c3715SXin Li + (3.0E0,4.0E0), (3.0E0,4.0E0), (3.0E0,4.0E0), 215*bf2c3715SXin Li + (3.0E0,4.0E0), (3.0E0,4.0E0), (3.0E0,4.0E0), 216*bf2c3715SXin Li + (0.03E0,-0.09E0), (0.15E0,-0.03E0), 217*bf2c3715SXin Li + (5.0E0,6.0E0), (5.0E0,6.0E0), (5.0E0,6.0E0), 218*bf2c3715SXin Li + (5.0E0,6.0E0), (5.0E0,6.0E0), (5.0E0,6.0E0), 219*bf2c3715SXin Li + (0.03E0,0.03E0), (-0.18E0,0.03E0), 220*bf2c3715SXin Li + (0.03E0,-0.09E0), (7.0E0,8.0E0), (7.0E0,8.0E0), 221*bf2c3715SXin Li + (7.0E0,8.0E0), (7.0E0,8.0E0), (7.0E0,8.0E0), 222*bf2c3715SXin Li + (0.09E0,0.03E0), (0.15E0,0.00E0), 223*bf2c3715SXin Li + (0.00E0,0.15E0), (0.00E0,0.06E0), (2.0E0,3.0E0), 224*bf2c3715SXin Li + (2.0E0,3.0E0), (2.0E0,3.0E0), (2.0E0,3.0E0)/ 225*bf2c3715SXin Li DATA ((CTRUE6(I,J,2),I=1,8),J=1,5)/(0.1E0,0.1E0), 226*bf2c3715SXin Li + (4.0E0,5.0E0), (4.0E0,5.0E0), (4.0E0,5.0E0), 227*bf2c3715SXin Li + (4.0E0,5.0E0), (4.0E0,5.0E0), (4.0E0,5.0E0), 228*bf2c3715SXin Li + (4.0E0,5.0E0), (0.09E0,-0.12E0), (6.0E0,7.0E0), 229*bf2c3715SXin Li + (6.0E0,7.0E0), (6.0E0,7.0E0), (6.0E0,7.0E0), 230*bf2c3715SXin Li + (6.0E0,7.0E0), (6.0E0,7.0E0), (6.0E0,7.0E0), 231*bf2c3715SXin Li + (0.03E0,-0.09E0), (8.0E0,9.0E0), 232*bf2c3715SXin Li + (0.15E0,-0.03E0), (2.0E0,5.0E0), (2.0E0,5.0E0), 233*bf2c3715SXin Li + (2.0E0,5.0E0), (2.0E0,5.0E0), (2.0E0,5.0E0), 234*bf2c3715SXin Li + (0.03E0,0.03E0), (3.0E0,6.0E0), 235*bf2c3715SXin Li + (-0.18E0,0.03E0), (4.0E0,7.0E0), 236*bf2c3715SXin Li + (0.03E0,-0.09E0), (7.0E0,2.0E0), (7.0E0,2.0E0), 237*bf2c3715SXin Li + (7.0E0,2.0E0), (0.09E0,0.03E0), (5.0E0,8.0E0), 238*bf2c3715SXin Li + (0.15E0,0.00E0), (6.0E0,9.0E0), (0.00E0,0.15E0), 239*bf2c3715SXin Li + (8.0E0,3.0E0), (0.00E0,0.06E0), (9.0E0,4.0E0)/ 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* .. SCNRM2 .. 252*bf2c3715SXin Li CALL STEST1(SCNRM2(N,CX,INCX),STRUE2(NP1),STRUE2(NP1), 253*bf2c3715SXin Li + SFAC) 254*bf2c3715SXin Li ELSE IF (ICASE.EQ.7) THEN 255*bf2c3715SXin Li* .. SCASUM .. 256*bf2c3715SXin Li CALL STEST1(SCASUM(N,CX,INCX),STRUE4(NP1),STRUE4(NP1), 257*bf2c3715SXin Li + SFAC) 258*bf2c3715SXin Li ELSE IF (ICASE.EQ.8) THEN 259*bf2c3715SXin Li* .. CSCAL .. 260*bf2c3715SXin Li CALL CSCAL(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* .. CSSCAL .. 265*bf2c3715SXin Li CALL CSSCAL(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* .. ICAMAX .. 270*bf2c3715SXin Li CALL ITEST1(ICAMAX(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* CSCAL 282*bf2c3715SXin Li* Add a test for alpha equal to zero. 283*bf2c3715SXin Li CA = (0.0E0,0.0E0) 284*bf2c3715SXin Li DO 80 I = 1, 5 285*bf2c3715SXin Li MWPCT(I) = (0.0E0,0.0E0) 286*bf2c3715SXin Li MWPCS(I) = (1.0E0,1.0E0) 287*bf2c3715SXin Li 80 CONTINUE 288*bf2c3715SXin Li CALL CSCAL(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* CSSCAL 292*bf2c3715SXin Li* Add a test for alpha equal to zero. 293*bf2c3715SXin Li SA = 0.0E0 294*bf2c3715SXin Li DO 100 I = 1, 5 295*bf2c3715SXin Li MWPCT(I) = (0.0E0,0.0E0) 296*bf2c3715SXin Li MWPCS(I) = (1.0E0,1.0E0) 297*bf2c3715SXin Li 100 CONTINUE 298*bf2c3715SXin Li CALL CSSCAL(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.0E0 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 CSSCAL(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.0E0 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 CSSCAL(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 REAL 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 CA 330*bf2c3715SXin Li INTEGER I, J, KI, KN, KSIZE, LENX, LENY, MX, MY 331*bf2c3715SXin Li* .. Local Arrays .. 332*bf2c3715SXin Li COMPLEX 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 CDOTC, CDOTU 338*bf2c3715SXin Li EXTERNAL CDOTC, CDOTU 339*bf2c3715SXin Li* .. External Subroutines .. 340*bf2c3715SXin Li EXTERNAL CAXPY, CCOPY, CSWAP, 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.4E0,-0.7E0)/ 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.7E0,-0.8E0), (-0.4E0,-0.7E0), 352*bf2c3715SXin Li + (-0.1E0,-0.9E0), (0.2E0,-0.8E0), 353*bf2c3715SXin Li + (-0.9E0,-0.4E0), (0.1E0,0.4E0), (-0.6E0,0.6E0)/ 354*bf2c3715SXin Li DATA CY1/(0.6E0,-0.6E0), (-0.9E0,0.5E0), 355*bf2c3715SXin Li + (0.7E0,-0.6E0), (0.1E0,-0.5E0), (-0.1E0,-0.2E0), 356*bf2c3715SXin Li + (-0.5E0,-0.3E0), (0.8E0,-0.7E0)/ 357*bf2c3715SXin Li DATA ((CT8(I,J,1),I=1,7),J=1,4)/(0.6E0,-0.6E0), 358*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 359*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 360*bf2c3715SXin Li + (0.32E0,-1.41E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 361*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 362*bf2c3715SXin Li + (0.0E0,0.0E0), (0.32E0,-1.41E0), 363*bf2c3715SXin Li + (-1.55E0,0.5E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 364*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 365*bf2c3715SXin Li + (0.32E0,-1.41E0), (-1.55E0,0.5E0), 366*bf2c3715SXin Li + (0.03E0,-0.89E0), (-0.38E0,-0.96E0), 367*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0)/ 368*bf2c3715SXin Li DATA ((CT8(I,J,2),I=1,7),J=1,4)/(0.6E0,-0.6E0), 369*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 370*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 371*bf2c3715SXin Li + (0.32E0,-1.41E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 372*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 373*bf2c3715SXin Li + (0.0E0,0.0E0), (-0.07E0,-0.89E0), 374*bf2c3715SXin Li + (-0.9E0,0.5E0), (0.42E0,-1.41E0), (0.0E0,0.0E0), 375*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 376*bf2c3715SXin Li + (0.78E0,0.06E0), (-0.9E0,0.5E0), 377*bf2c3715SXin Li + (0.06E0,-0.13E0), (0.1E0,-0.5E0), 378*bf2c3715SXin Li + (-0.77E0,-0.49E0), (-0.5E0,-0.3E0), 379*bf2c3715SXin Li + (0.52E0,-1.51E0)/ 380*bf2c3715SXin Li DATA ((CT8(I,J,3),I=1,7),J=1,4)/(0.6E0,-0.6E0), 381*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 382*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 383*bf2c3715SXin Li + (0.32E0,-1.41E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 384*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 385*bf2c3715SXin Li + (0.0E0,0.0E0), (-0.07E0,-0.89E0), 386*bf2c3715SXin Li + (-1.18E0,-0.31E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 387*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 388*bf2c3715SXin Li + (0.78E0,0.06E0), (-1.54E0,0.97E0), 389*bf2c3715SXin Li + (0.03E0,-0.89E0), (-0.18E0,-1.31E0), 390*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0)/ 391*bf2c3715SXin Li DATA ((CT8(I,J,4),I=1,7),J=1,4)/(0.6E0,-0.6E0), 392*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 393*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 394*bf2c3715SXin Li + (0.32E0,-1.41E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 395*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 396*bf2c3715SXin Li + (0.0E0,0.0E0), (0.32E0,-1.41E0), (-0.9E0,0.5E0), 397*bf2c3715SXin Li + (0.05E0,-0.6E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 398*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.32E0,-1.41E0), 399*bf2c3715SXin Li + (-0.9E0,0.5E0), (0.05E0,-0.6E0), (0.1E0,-0.5E0), 400*bf2c3715SXin Li + (-0.77E0,-0.49E0), (-0.5E0,-0.3E0), 401*bf2c3715SXin Li + (0.32E0,-1.16E0)/ 402*bf2c3715SXin Li DATA CT7/(0.0E0,0.0E0), (-0.06E0,-0.90E0), 403*bf2c3715SXin Li + (0.65E0,-0.47E0), (-0.34E0,-1.22E0), 404*bf2c3715SXin Li + (0.0E0,0.0E0), (-0.06E0,-0.90E0), 405*bf2c3715SXin Li + (-0.59E0,-1.46E0), (-1.04E0,-0.04E0), 406*bf2c3715SXin Li + (0.0E0,0.0E0), (-0.06E0,-0.90E0), 407*bf2c3715SXin Li + (-0.83E0,0.59E0), (0.07E0,-0.37E0), 408*bf2c3715SXin Li + (0.0E0,0.0E0), (-0.06E0,-0.90E0), 409*bf2c3715SXin Li + (-0.76E0,-1.15E0), (-1.33E0,-1.82E0)/ 410*bf2c3715SXin Li DATA CT6/(0.0E0,0.0E0), (0.90E0,0.06E0), 411*bf2c3715SXin Li + (0.91E0,-0.77E0), (1.80E0,-0.10E0), 412*bf2c3715SXin Li + (0.0E0,0.0E0), (0.90E0,0.06E0), (1.45E0,0.74E0), 413*bf2c3715SXin Li + (0.20E0,0.90E0), (0.0E0,0.0E0), (0.90E0,0.06E0), 414*bf2c3715SXin Li + (-0.55E0,0.23E0), (0.83E0,-0.39E0), 415*bf2c3715SXin Li + (0.0E0,0.0E0), (0.90E0,0.06E0), (1.04E0,0.79E0), 416*bf2c3715SXin Li + (1.95E0,1.22E0)/ 417*bf2c3715SXin Li DATA ((CT10X(I,J,1),I=1,7),J=1,4)/(0.7E0,-0.8E0), 418*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 419*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 420*bf2c3715SXin Li + (0.6E0,-0.6E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 421*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 422*bf2c3715SXin Li + (0.0E0,0.0E0), (0.6E0,-0.6E0), (-0.9E0,0.5E0), 423*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 424*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.6E0,-0.6E0), 425*bf2c3715SXin Li + (-0.9E0,0.5E0), (0.7E0,-0.6E0), (0.1E0,-0.5E0), 426*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0)/ 427*bf2c3715SXin Li DATA ((CT10X(I,J,2),I=1,7),J=1,4)/(0.7E0,-0.8E0), 428*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 429*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 430*bf2c3715SXin Li + (0.6E0,-0.6E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 431*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 432*bf2c3715SXin Li + (0.0E0,0.0E0), (0.7E0,-0.6E0), (-0.4E0,-0.7E0), 433*bf2c3715SXin Li + (0.6E0,-0.6E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 434*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.8E0,-0.7E0), 435*bf2c3715SXin Li + (-0.4E0,-0.7E0), (-0.1E0,-0.2E0), 436*bf2c3715SXin Li + (0.2E0,-0.8E0), (0.7E0,-0.6E0), (0.1E0,0.4E0), 437*bf2c3715SXin Li + (0.6E0,-0.6E0)/ 438*bf2c3715SXin Li DATA ((CT10X(I,J,3),I=1,7),J=1,4)/(0.7E0,-0.8E0), 439*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 440*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 441*bf2c3715SXin Li + (0.6E0,-0.6E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 442*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 443*bf2c3715SXin Li + (0.0E0,0.0E0), (-0.9E0,0.5E0), (-0.4E0,-0.7E0), 444*bf2c3715SXin Li + (0.6E0,-0.6E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 445*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.1E0,-0.5E0), 446*bf2c3715SXin Li + (-0.4E0,-0.7E0), (0.7E0,-0.6E0), (0.2E0,-0.8E0), 447*bf2c3715SXin Li + (-0.9E0,0.5E0), (0.1E0,0.4E0), (0.6E0,-0.6E0)/ 448*bf2c3715SXin Li DATA ((CT10X(I,J,4),I=1,7),J=1,4)/(0.7E0,-0.8E0), 449*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 450*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 451*bf2c3715SXin Li + (0.6E0,-0.6E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 452*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 453*bf2c3715SXin Li + (0.0E0,0.0E0), (0.6E0,-0.6E0), (0.7E0,-0.6E0), 454*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 455*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.6E0,-0.6E0), 456*bf2c3715SXin Li + (0.7E0,-0.6E0), (-0.1E0,-0.2E0), (0.8E0,-0.7E0), 457*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0)/ 458*bf2c3715SXin Li DATA ((CT10Y(I,J,1),I=1,7),J=1,4)/(0.6E0,-0.6E0), 459*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 460*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 461*bf2c3715SXin Li + (0.7E0,-0.8E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 462*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 463*bf2c3715SXin Li + (0.0E0,0.0E0), (0.7E0,-0.8E0), (-0.4E0,-0.7E0), 464*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 465*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.7E0,-0.8E0), 466*bf2c3715SXin Li + (-0.4E0,-0.7E0), (-0.1E0,-0.9E0), 467*bf2c3715SXin Li + (0.2E0,-0.8E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 468*bf2c3715SXin Li + (0.0E0,0.0E0)/ 469*bf2c3715SXin Li DATA ((CT10Y(I,J,2),I=1,7),J=1,4)/(0.6E0,-0.6E0), 470*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 471*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 472*bf2c3715SXin Li + (0.7E0,-0.8E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 473*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 474*bf2c3715SXin Li + (0.0E0,0.0E0), (-0.1E0,-0.9E0), (-0.9E0,0.5E0), 475*bf2c3715SXin Li + (0.7E0,-0.8E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 476*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (-0.6E0,0.6E0), 477*bf2c3715SXin Li + (-0.9E0,0.5E0), (-0.9E0,-0.4E0), (0.1E0,-0.5E0), 478*bf2c3715SXin Li + (-0.1E0,-0.9E0), (-0.5E0,-0.3E0), 479*bf2c3715SXin Li + (0.7E0,-0.8E0)/ 480*bf2c3715SXin Li DATA ((CT10Y(I,J,3),I=1,7),J=1,4)/(0.6E0,-0.6E0), 481*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 482*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 483*bf2c3715SXin Li + (0.7E0,-0.8E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 484*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 485*bf2c3715SXin Li + (0.0E0,0.0E0), (-0.1E0,-0.9E0), (0.7E0,-0.8E0), 486*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 487*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (-0.6E0,0.6E0), 488*bf2c3715SXin Li + (-0.9E0,-0.4E0), (-0.1E0,-0.9E0), 489*bf2c3715SXin Li + (0.7E0,-0.8E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 490*bf2c3715SXin Li + (0.0E0,0.0E0)/ 491*bf2c3715SXin Li DATA ((CT10Y(I,J,4),I=1,7),J=1,4)/(0.6E0,-0.6E0), 492*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 493*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 494*bf2c3715SXin Li + (0.7E0,-0.8E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 495*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 496*bf2c3715SXin Li + (0.0E0,0.0E0), (0.7E0,-0.8E0), (-0.9E0,0.5E0), 497*bf2c3715SXin Li + (-0.4E0,-0.7E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 498*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.7E0,-0.8E0), 499*bf2c3715SXin Li + (-0.9E0,0.5E0), (-0.4E0,-0.7E0), (0.1E0,-0.5E0), 500*bf2c3715SXin Li + (-0.1E0,-0.9E0), (-0.5E0,-0.3E0), 501*bf2c3715SXin Li + (0.2E0,-0.8E0)/ 502*bf2c3715SXin Li DATA CSIZE1/(0.0E0,0.0E0), (0.9E0,0.9E0), 503*bf2c3715SXin Li + (1.63E0,1.73E0), (2.90E0,2.78E0)/ 504*bf2c3715SXin Li DATA CSIZE3/(0.0E0,0.0E0), (0.0E0,0.0E0), 505*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 506*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (1.17E0,1.17E0), 507*bf2c3715SXin Li + (1.17E0,1.17E0), (1.17E0,1.17E0), 508*bf2c3715SXin Li + (1.17E0,1.17E0), (1.17E0,1.17E0), 509*bf2c3715SXin Li + (1.17E0,1.17E0), (1.17E0,1.17E0)/ 510*bf2c3715SXin Li DATA CSIZE2/(0.0E0,0.0E0), (0.0E0,0.0E0), 511*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), 512*bf2c3715SXin Li + (0.0E0,0.0E0), (0.0E0,0.0E0), (1.54E0,1.54E0), 513*bf2c3715SXin Li + (1.54E0,1.54E0), (1.54E0,1.54E0), 514*bf2c3715SXin Li + (1.54E0,1.54E0), (1.54E0,1.54E0), 515*bf2c3715SXin Li + (1.54E0,1.54E0), (1.54E0,1.54E0)/ 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* .. CDOTC .. 535*bf2c3715SXin Li CDOT(1) = CDOTC(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* .. CDOTU .. 539*bf2c3715SXin Li CDOT(1) = CDOTU(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* .. CAXPY .. 543*bf2c3715SXin Li CALL CAXPY(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* .. CCOPY .. 547*bf2c3715SXin Li CALL CCOPY(N,CX,INCX,CY,INCY) 548*bf2c3715SXin Li CALL CTEST(LENY,CY,CT10Y(1,KN,KI),CSIZE3,1.0E0) 549*bf2c3715SXin Li ELSE IF (ICASE.EQ.5) THEN 550*bf2c3715SXin Li* .. CSWAP .. 551*bf2c3715SXin Li CALL CSWAP(N,CX,INCX,CY,INCY) 552*bf2c3715SXin Li CALL CTEST(LENX,CX,CT10X(1,KN,KI),CSIZE3,1.0E0) 553*bf2c3715SXin Li CALL CTEST(LENY,CY,CT10Y(1,KN,KI),CSIZE3,1.0E0) 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 REAL ZERO 575*bf2c3715SXin Li PARAMETER (NOUT=6, ZERO=0.0E0) 576*bf2c3715SXin Li* .. Scalar Arguments .. 577*bf2c3715SXin Li REAL SFAC 578*bf2c3715SXin Li INTEGER LEN 579*bf2c3715SXin Li* .. Array Arguments .. 580*bf2c3715SXin Li REAL 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 REAL SD 586*bf2c3715SXin Li INTEGER I 587*bf2c3715SXin Li* .. External Functions .. 588*bf2c3715SXin Li REAL 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,2E36.8,2E12.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 REAL SCOMP1, SFAC, STRUE1 630*bf2c3715SXin Li* .. Array Arguments .. 631*bf2c3715SXin Li REAL SSIZE(*) 632*bf2c3715SXin Li* .. Local Arrays .. 633*bf2c3715SXin Li REAL 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 REAL 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 REAL 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 REAL SFAC 661*bf2c3715SXin Li INTEGER LEN 662*bf2c3715SXin Li* .. Array Arguments .. 663*bf2c3715SXin Li COMPLEX CCOMP(LEN), CSIZE(LEN), CTRUE(LEN) 664*bf2c3715SXin Li* .. Local Scalars .. 665*bf2c3715SXin Li INTEGER I 666*bf2c3715SXin Li* .. Local Arrays .. 667*bf2c3715SXin Li REAL 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 AIMAG, REAL 672*bf2c3715SXin Li* .. Executable Statements .. 673*bf2c3715SXin Li DO 20 I = 1, LEN 674*bf2c3715SXin Li SCOMP(2*I-1) = REAL(CCOMP(I)) 675*bf2c3715SXin Li SCOMP(2*I) = AIMAG(CCOMP(I)) 676*bf2c3715SXin Li STRUE(2*I-1) = REAL(CTRUE(I)) 677*bf2c3715SXin Li STRUE(2*I) = AIMAG(CTRUE(I)) 678*bf2c3715SXin Li SSIZE(2*I-1) = REAL(CSIZE(I)) 679*bf2c3715SXin Li SSIZE(2*I) = AIMAG(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