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