181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray PROGRAM DCBLAT1 281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Test program for the DOUBLE PRECISION Level 1 CBLAS. 381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Based upon the original CBLAS test routine together with: 481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* F06EAF Example Program Text 581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Parameters .. 681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER NOUT 781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray PARAMETER (NOUT=6) 881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Scalars in Common .. 981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER ICASE, INCX, INCY, MODE, N 1081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LOGICAL PASS 1181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Local Scalars .. 1281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION SFAC 1381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER IC 1481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. External Subroutines .. 1581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray EXTERNAL CHECK0, CHECK1, CHECK2, CHECK3, HEADER 1681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Common blocks .. 1781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS 1881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Data statements .. 1981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DATA SFAC/9.765625D-4/ 2081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Executable Statements .. 2181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE (NOUT,99999) 2281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 20 IC = 1, 10 2381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ICASE = IC 2481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL HEADER 2581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 2681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Initialize PASS, INCX, INCY, and MODE for a new case. .. 2781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. the value 9999 for INCX, INCY or MODE will appear in the .. 2881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. detailed output, if any, for cases that do not involve .. 2981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. these parameters .. 3081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 3181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray PASS = .TRUE. 3281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INCX = 9999 3381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INCY = 9999 3481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MODE = 9999 3581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF (ICASE.EQ.3) THEN 3681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL CHECK0(SFAC) 3781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE IF (ICASE.EQ.7 .OR. ICASE.EQ.8 .OR. ICASE.EQ.9 .OR. 3881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + ICASE.EQ.10) THEN 3981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL CHECK1(SFAC) 4081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE IF (ICASE.EQ.1 .OR. ICASE.EQ.2 .OR. ICASE.EQ.5 .OR. 4181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + ICASE.EQ.6) THEN 4281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL CHECK2(SFAC) 4381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE IF (ICASE.EQ.4) THEN 4481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL CHECK3(SFAC) 4581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 4681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* -- Print 4781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF (PASS) WRITE (NOUT,99998) 4881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 20 CONTINUE 4981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray STOP 5081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 5181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray99999 FORMAT (' Real CBLAS Test Program Results',/1X) 5281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray99998 FORMAT (' ----- PASS -----') 5381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END 5481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray SUBROUTINE HEADER 5581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Parameters .. 5681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER NOUT 5781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray PARAMETER (NOUT=6) 5881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Scalars in Common .. 5981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER ICASE, INCX, INCY, MODE, N 6081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LOGICAL PASS 6181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Local Arrays .. 6281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CHARACTER*15 L(10) 6381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Common blocks .. 6481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS 6581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Data statements .. 6681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DATA L(1)/'CBLAS_DDOT'/ 6781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DATA L(2)/'CBLAS_DAXPY '/ 6881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DATA L(3)/'CBLAS_DROTG '/ 6981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DATA L(4)/'CBLAS_DROT '/ 7081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DATA L(5)/'CBLAS_DCOPY '/ 7181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DATA L(6)/'CBLAS_DSWAP '/ 7281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DATA L(7)/'CBLAS_DNRM2 '/ 7381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DATA L(8)/'CBLAS_DASUM '/ 7481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DATA L(9)/'CBLAS_DSCAL '/ 7581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DATA L(10)/'CBLAS_IDAMAX'/ 7681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Executable Statements .. 7781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE (NOUT,99999) ICASE, L(ICASE) 7881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray RETURN 7981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 8081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray99999 FORMAT (/' Test of subprogram number',I3,9X,A15) 8181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END 8281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray SUBROUTINE CHECK0(SFAC) 8381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Parameters .. 8481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER NOUT 8581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray PARAMETER (NOUT=6) 8681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Scalar Arguments .. 8781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION SFAC 8881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Scalars in Common .. 8981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER ICASE, INCX, INCY, MODE, N 9081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LOGICAL PASS 9181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Local Scalars .. 9281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION SA, SB, SC, SS 9381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER K 9481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Local Arrays .. 9581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION DA1(8), DATRUE(8), DB1(8), DBTRUE(8), DC1(8), 9681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + DS1(8) 9781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. External Subroutines .. 9881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray EXTERNAL DROTGTEST, STEST1 9981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Common blocks .. 10081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS 10181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Data statements .. 10281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DATA DA1/0.3D0, 0.4D0, -0.3D0, -0.4D0, -0.3D0, 0.0D0, 10381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 1.0D0/ 10481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DATA DB1/0.4D0, 0.3D0, 0.4D0, 0.3D0, -0.4D0, 0.0D0, 10581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 1.0D0, 0.0D0/ 10681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DATA DC1/0.6D0, 0.8D0, -0.6D0, 0.8D0, 0.6D0, 1.0D0, 10781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 1.0D0/ 10881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DATA DS1/0.8D0, 0.6D0, 0.8D0, -0.6D0, 0.8D0, 0.0D0, 10981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 1.0D0, 0.0D0/ 11081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DATA DATRUE/0.5D0, 0.5D0, 0.5D0, -0.5D0, -0.5D0, 11181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 1.0D0, 1.0D0/ 11281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DATA DBTRUE/0.0D0, 0.6D0, 0.0D0, -0.6D0, 0.0D0, 11381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 1.0D0, 0.0D0/ 11481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Executable Statements .. 11581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 11681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Compute true values which cannot be prestored 11781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* in decimal notation 11881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 11981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DBTRUE(1) = 1.0D0/0.6D0 12081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DBTRUE(3) = -1.0D0/0.6D0 12181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DBTRUE(5) = 1.0D0/0.6D0 12281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 12381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 20 K = 1, 8 12481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Set N=K for identification in output if any .. 12581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray N = K 12681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF (ICASE.EQ.3) THEN 12781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. DROTGTEST .. 12881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF (K.GT.8) GO TO 40 12981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray SA = DA1(K) 13081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray SB = DB1(K) 13181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL DROTGTEST(SA,SB,SC,SS) 13281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL STEST1(SA,DATRUE(K),DATRUE(K),SFAC) 13381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL STEST1(SB,DBTRUE(K),DBTRUE(K),SFAC) 13481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL STEST1(SC,DC1(K),DC1(K),SFAC) 13581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL STEST1(SS,DS1(K),DS1(K),SFAC) 13681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 13781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE (NOUT,*) ' Shouldn''t be here in CHECK0' 13881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray STOP 13981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 14081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 20 CONTINUE 14181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 40 RETURN 14281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END 14381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray SUBROUTINE CHECK1(SFAC) 14481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Parameters .. 14581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER NOUT 14681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray PARAMETER (NOUT=6) 14781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Scalar Arguments .. 14881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION SFAC 14981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Scalars in Common .. 15081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER ICASE, INCX, INCY, MODE, N 15181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LOGICAL PASS 15281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Local Scalars .. 15381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER I, LEN, NP1 15481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Local Arrays .. 15581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION DTRUE1(5), DTRUE3(5), DTRUE5(8,5,2), DV(8,5,2), 15681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + SA(10), STEMP(1), STRUE(8), SX(8) 15781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER ITRUE2(5) 15881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. External Functions .. 15981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION DASUMTEST, DNRM2TEST 16081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER IDAMAXTEST 16181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray EXTERNAL DASUMTEST, DNRM2TEST, IDAMAXTEST 16281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. External Subroutines .. 16381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray EXTERNAL ITEST1, DSCALTEST, STEST, STEST1 16481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Intrinsic Functions .. 16581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTRINSIC MAX 16681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Common blocks .. 16781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS 16881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Data statements .. 16981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DATA SA/0.3D0, -1.0D0, 0.0D0, 1.0D0, 0.3D0, 0.3D0, 17081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.3D0, 0.3D0, 0.3D0, 0.3D0/ 17181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DATA DV/0.1D0, 2.0D0, 2.0D0, 2.0D0, 2.0D0, 2.0D0, 17281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 2.0D0, 2.0D0, 0.3D0, 3.0D0, 3.0D0, 3.0D0, 3.0D0, 17381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 3.0D0, 3.0D0, 3.0D0, 0.3D0, -0.4D0, 4.0D0, 17481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 4.0D0, 4.0D0, 4.0D0, 4.0D0, 4.0D0, 0.2D0, 17581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + -0.6D0, 0.3D0, 5.0D0, 5.0D0, 5.0D0, 5.0D0, 17681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 5.0D0, 0.1D0, -0.3D0, 0.5D0, -0.1D0, 6.0D0, 17781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 6.0D0, 6.0D0, 6.0D0, 0.1D0, 8.0D0, 8.0D0, 8.0D0, 17881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 8.0D0, 8.0D0, 8.0D0, 8.0D0, 0.3D0, 9.0D0, 9.0D0, 17981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 9.0D0, 9.0D0, 9.0D0, 9.0D0, 9.0D0, 0.3D0, 2.0D0, 18081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + -0.4D0, 2.0D0, 2.0D0, 2.0D0, 2.0D0, 2.0D0, 18181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.2D0, 3.0D0, -0.6D0, 5.0D0, 0.3D0, 2.0D0, 18281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 2.0D0, 2.0D0, 0.1D0, 4.0D0, -0.3D0, 6.0D0, 18381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + -0.5D0, 7.0D0, -0.1D0, 3.0D0/ 18481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DATA DTRUE1/0.0D0, 0.3D0, 0.5D0, 0.7D0, 0.6D0/ 18581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DATA DTRUE3/0.0D0, 0.3D0, 0.7D0, 1.1D0, 1.0D0/ 18681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DATA DTRUE5/0.10D0, 2.0D0, 2.0D0, 2.0D0, 2.0D0, 18781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 2.0D0, 2.0D0, 2.0D0, -0.3D0, 3.0D0, 3.0D0, 18881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 3.0D0, 3.0D0, 3.0D0, 3.0D0, 3.0D0, 0.0D0, 0.0D0, 18981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 4.0D0, 4.0D0, 4.0D0, 4.0D0, 4.0D0, 4.0D0, 19081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.20D0, -0.60D0, 0.30D0, 5.0D0, 5.0D0, 5.0D0, 19181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 5.0D0, 5.0D0, 0.03D0, -0.09D0, 0.15D0, -0.03D0, 19281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 6.0D0, 6.0D0, 6.0D0, 6.0D0, 0.10D0, 8.0D0, 19381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 8.0D0, 8.0D0, 8.0D0, 8.0D0, 8.0D0, 8.0D0, 19481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.09D0, 9.0D0, 9.0D0, 9.0D0, 9.0D0, 9.0D0, 19581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 9.0D0, 9.0D0, 0.09D0, 2.0D0, -0.12D0, 2.0D0, 19681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 2.0D0, 2.0D0, 2.0D0, 2.0D0, 0.06D0, 3.0D0, 19781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + -0.18D0, 5.0D0, 0.09D0, 2.0D0, 2.0D0, 2.0D0, 19881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.03D0, 4.0D0, -0.09D0, 6.0D0, -0.15D0, 7.0D0, 19981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + -0.03D0, 3.0D0/ 20081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DATA ITRUE2/0, 1, 2, 2, 3/ 20181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Executable Statements .. 20281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 80 INCX = 1, 2 20381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 60 NP1 = 1, 5 20481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray N = NP1 - 1 20581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LEN = 2*MAX(N,1) 20681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Set vector arguments .. 20781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 20 I = 1, LEN 20881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray SX(I) = DV(I,NP1,INCX) 20981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 20 CONTINUE 21081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 21181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF (ICASE.EQ.7) THEN 21281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. DNRM2TEST .. 21381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray STEMP(1) = DTRUE1(NP1) 21481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL STEST1(DNRM2TEST(N,SX,INCX),STEMP,STEMP,SFAC) 21581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE IF (ICASE.EQ.8) THEN 21681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. DASUMTEST .. 21781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray STEMP(1) = DTRUE3(NP1) 21881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL STEST1(DASUMTEST(N,SX,INCX),STEMP,STEMP,SFAC) 21981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE IF (ICASE.EQ.9) THEN 22081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. DSCALTEST .. 22181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL DSCALTEST(N,SA((INCX-1)*5+NP1),SX,INCX) 22281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 40 I = 1, LEN 22381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray STRUE(I) = DTRUE5(I,NP1,INCX) 22481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 40 CONTINUE 22581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL STEST(LEN,SX,STRUE,STRUE,SFAC) 22681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE IF (ICASE.EQ.10) THEN 22781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. IDAMAXTEST .. 22881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL ITEST1(IDAMAXTEST(N,SX,INCX),ITRUE2(NP1)) 22981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 23081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE (NOUT,*) ' Shouldn''t be here in CHECK1' 23181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray STOP 23281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 23381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 60 CONTINUE 23481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 80 CONTINUE 23581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray RETURN 23681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END 23781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray SUBROUTINE CHECK2(SFAC) 23881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Parameters .. 23981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER NOUT 24081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray PARAMETER (NOUT=6) 24181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Scalar Arguments .. 24281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION SFAC 24381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Scalars in Common .. 24481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER ICASE, INCX, INCY, MODE, N 24581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LOGICAL PASS 24681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Local Scalars .. 24781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION SA 24881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER I, J, KI, KN, KSIZE, LENX, LENY, MX, MY 24981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Local Arrays .. 25081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION DT10X(7,4,4), DT10Y(7,4,4), DT7(4,4), 25181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + DT8(7,4,4), DX1(7), 25281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + DY1(7), SSIZE1(4), SSIZE2(14,2), STX(7), STY(7), 25381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + SX(7), SY(7) 25481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER INCXS(4), INCYS(4), LENS(4,2), NS(4) 25581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. External Functions .. 25681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray EXTERNAL DDOTTEST 25781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION DDOTTEST 25881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. External Subroutines .. 25981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray EXTERNAL DAXPYTEST, DCOPYTEST, DSWAPTEST, STEST, STEST1 26081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Intrinsic Functions .. 26181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTRINSIC ABS, MIN 26281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Common blocks .. 26381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS 26481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Data statements .. 26581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DATA SA/0.3D0/ 26681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DATA INCXS/1, 2, -2, -1/ 26781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DATA INCYS/1, -2, 1, -2/ 26881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DATA LENS/1, 1, 2, 4, 1, 1, 3, 7/ 26981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DATA NS/0, 1, 2, 4/ 27081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DATA DX1/0.6D0, 0.1D0, -0.5D0, 0.8D0, 0.9D0, -0.3D0, 27181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + -0.4D0/ 27281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DATA DY1/0.5D0, -0.9D0, 0.3D0, 0.7D0, -0.6D0, 0.2D0, 27381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.8D0/ 27481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DATA DT7/0.0D0, 0.30D0, 0.21D0, 0.62D0, 0.0D0, 27581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.30D0, -0.07D0, 0.85D0, 0.0D0, 0.30D0, -0.79D0, 27681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + -0.74D0, 0.0D0, 0.30D0, 0.33D0, 1.27D0/ 27781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DATA DT8/0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 27881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.68D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 27981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.0D0, 0.68D0, -0.87D0, 0.0D0, 0.0D0, 28081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.0D0, 0.0D0, 0.68D0, -0.87D0, 0.15D0, 28181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.94D0, 0.0D0, 0.0D0, 0.0D0, 0.5D0, 0.0D0, 28281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.68D0, 28381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 28481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.35D0, -0.9D0, 0.48D0, 0.0D0, 0.0D0, 0.0D0, 28581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.38D0, -0.9D0, 0.57D0, 0.7D0, -0.75D0, 28681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.2D0, 0.98D0, 0.5D0, 0.0D0, 0.0D0, 0.0D0, 28781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.0D0, 0.0D0, 0.68D0, 0.0D0, 0.0D0, 28881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.35D0, -0.72D0, 28981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.38D0, 29081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + -0.63D0, 0.15D0, 0.88D0, 0.0D0, 0.0D0, 0.0D0, 29181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 29281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.68D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 29381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.68D0, -0.9D0, 0.33D0, 0.0D0, 0.0D0, 29481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.0D0, 0.68D0, -0.9D0, 0.33D0, 0.7D0, 29581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + -0.75D0, 0.2D0, 1.04D0/ 29681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DATA DT10X/0.6D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 29781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 29881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.5D0, -0.9D0, 0.0D0, 0.0D0, 0.0D0, 29981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.0D0, 0.5D0, -0.9D0, 0.3D0, 0.7D0, 30081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.0D0, 0.0D0, 0.6D0, 0.0D0, 0.0D0, 0.0D0, 30181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.0D0, 0.0D0, 0.5D0, 0.0D0, 0.0D0, 0.0D0, 30281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.0D0, 0.0D0, 0.3D0, 0.1D0, 0.5D0, 0.0D0, 30381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.0D0, 0.0D0, 0.8D0, 0.1D0, -0.6D0, 30481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.8D0, 0.3D0, -0.3D0, 0.5D0, 0.6D0, 0.0D0, 30581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.5D0, 0.0D0, 30681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, -0.9D0, 30781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.1D0, 0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.7D0, 30881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.1D0, 0.3D0, 0.8D0, -0.9D0, -0.3D0, 0.5D0, 30981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.6D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 31081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 31181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.5D0, 0.3D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 31281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.5D0, 0.3D0, -0.6D0, 0.8D0, 0.0D0, 0.0D0, 31381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0/ 31481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DATA DT10Y/0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 31581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.6D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 31681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.6D0, 0.1D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 31781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.6D0, 0.1D0, -0.5D0, 0.8D0, 0.0D0, 31881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.0D0, 0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 31981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.0D0, 0.6D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 32081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.0D0, -0.5D0, -0.9D0, 0.6D0, 0.0D0, 32181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.0D0, 0.0D0, -0.4D0, -0.9D0, 0.9D0, 32281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.7D0, -0.5D0, 0.2D0, 0.6D0, 0.5D0, 0.0D0, 32381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.6D0, 0.0D0, 32481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, -0.5D0, 32581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.6D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 32681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + -0.4D0, 0.9D0, -0.5D0, 0.6D0, 0.0D0, 0.0D0, 32781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 32881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.6D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 32981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.6D0, -0.9D0, 0.1D0, 0.0D0, 0.0D0, 33081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.0D0, 0.6D0, -0.9D0, 0.1D0, 0.7D0, 33181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + -0.5D0, 0.2D0, 0.8D0/ 33281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DATA SSIZE1/0.0D0, 0.3D0, 1.6D0, 3.2D0/ 33381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DATA SSIZE2/0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 33481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 33581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0, 33681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 1.17D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0, 33781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 1.17D0, 1.17D0, 1.17D0/ 33881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Executable Statements .. 33981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 34081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 120 KI = 1, 4 34181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INCX = INCXS(KI) 34281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INCY = INCYS(KI) 34381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MX = ABS(INCX) 34481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MY = ABS(INCY) 34581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 34681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 100 KN = 1, 4 34781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray N = NS(KN) 34881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray KSIZE = MIN(2,KN) 34981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LENX = LENS(KN,MX) 35081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LENY = LENS(KN,MY) 35181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Initialize all argument arrays .. 35281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 20 I = 1, 7 35381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray SX(I) = DX1(I) 35481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray SY(I) = DY1(I) 35581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 20 CONTINUE 35681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 35781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF (ICASE.EQ.1) THEN 35881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. DDOTTEST .. 35981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL STEST1(DDOTTEST(N,SX,INCX,SY,INCY),DT7(KN,KI), 36081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + SSIZE1(KN),SFAC) 36181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE IF (ICASE.EQ.2) THEN 36281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. DAXPYTEST .. 36381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL DAXPYTEST(N,SA,SX,INCX,SY,INCY) 36481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 40 J = 1, LENY 36581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray STY(J) = DT8(J,KN,KI) 36681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 40 CONTINUE 36781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL STEST(LENY,SY,STY,SSIZE2(1,KSIZE),SFAC) 36881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE IF (ICASE.EQ.5) THEN 36981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. DCOPYTEST .. 37081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 60 I = 1, 7 37181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray STY(I) = DT10Y(I,KN,KI) 37281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 60 CONTINUE 37381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL DCOPYTEST(N,SX,INCX,SY,INCY) 37481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL STEST(LENY,SY,STY,SSIZE2(1,1),1.0D0) 37581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE IF (ICASE.EQ.6) THEN 37681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. DSWAPTEST .. 37781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL DSWAPTEST(N,SX,INCX,SY,INCY) 37881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 80 I = 1, 7 37981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray STX(I) = DT10X(I,KN,KI) 38081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray STY(I) = DT10Y(I,KN,KI) 38181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 80 CONTINUE 38281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL STEST(LENX,SX,STX,SSIZE2(1,1),1.0D0) 38381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL STEST(LENY,SY,STY,SSIZE2(1,1),1.0D0) 38481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 38581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE (NOUT,*) ' Shouldn''t be here in CHECK2' 38681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray STOP 38781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 38881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 100 CONTINUE 38981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 120 CONTINUE 39081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray RETURN 39181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END 39281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray SUBROUTINE CHECK3(SFAC) 39381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Parameters .. 39481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER NOUT 39581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray PARAMETER (NOUT=6) 39681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Scalar Arguments .. 39781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION SFAC 39881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Scalars in Common .. 39981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER ICASE, INCX, INCY, MODE, N 40081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LOGICAL PASS 40181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Local Scalars .. 40281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION SC, SS 40381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER I, K, KI, KN, KSIZE, LENX, LENY, MX, MY 40481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Local Arrays .. 40581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION COPYX(5), COPYY(5), DT9X(7,4,4), DT9Y(7,4,4), 40681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + DX1(7), DY1(7), MWPC(11), MWPS(11), MWPSTX(5), 40781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + MWPSTY(5), MWPTX(11,5), MWPTY(11,5), MWPX(5), 40881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + MWPY(5), SSIZE2(14,2), STX(7), STY(7), SX(7), 40981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + SY(7) 41081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER INCXS(4), INCYS(4), LENS(4,2), MWPINX(11), 41181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + MWPINY(11), MWPN(11), NS(4) 41281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. External Subroutines .. 41381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray EXTERNAL STEST,DROTTEST 41481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Intrinsic Functions .. 41581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTRINSIC ABS, MIN 41681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Common blocks .. 41781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS 41881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Data statements .. 41981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DATA INCXS/1, 2, -2, -1/ 42081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DATA INCYS/1, -2, 1, -2/ 42181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DATA LENS/1, 1, 2, 4, 1, 1, 3, 7/ 42281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DATA NS/0, 1, 2, 4/ 42381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DATA DX1/0.6D0, 0.1D0, -0.5D0, 0.8D0, 0.9D0, -0.3D0, 42481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + -0.4D0/ 42581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DATA DY1/0.5D0, -0.9D0, 0.3D0, 0.7D0, -0.6D0, 0.2D0, 42681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.8D0/ 42781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DATA SC, SS/0.8D0, 0.6D0/ 42881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DATA DT9X/0.6D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 42981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.78D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 43081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.0D0, 0.78D0, -0.46D0, 0.0D0, 0.0D0, 43181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.0D0, 0.0D0, 0.78D0, -0.46D0, -0.22D0, 43281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 1.06D0, 0.0D0, 0.0D0, 0.0D0, 0.6D0, 0.0D0, 43381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.78D0, 43481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 43581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.66D0, 0.1D0, -0.1D0, 0.0D0, 0.0D0, 0.0D0, 43681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.96D0, 0.1D0, -0.76D0, 0.8D0, 0.90D0, 43781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + -0.3D0, -0.02D0, 0.6D0, 0.0D0, 0.0D0, 0.0D0, 43881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.0D0, 0.0D0, 0.78D0, 0.0D0, 0.0D0, 43981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.0D0, 0.0D0, 0.0D0, -0.06D0, 0.1D0, 44081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + -0.1D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.90D0, 44181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.1D0, -0.22D0, 0.8D0, 0.18D0, -0.3D0, -0.02D0, 44281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.6D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 44381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.78D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 44481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.78D0, 0.26D0, 0.0D0, 0.0D0, 0.0D0, 44581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.0D0, 0.78D0, 0.26D0, -0.76D0, 1.12D0, 44681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.0D0, 0.0D0/ 44781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DATA DT9Y/0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 44881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.04D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 44981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.0D0, 0.04D0, -0.78D0, 0.0D0, 0.0D0, 45081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.0D0, 0.0D0, 0.04D0, -0.78D0, 0.54D0, 45181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.08D0, 0.0D0, 0.0D0, 0.0D0, 0.5D0, 0.0D0, 45281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.04D0, 45381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.7D0, 45481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + -0.9D0, -0.12D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 45581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.64D0, -0.9D0, -0.30D0, 0.7D0, -0.18D0, 0.2D0, 45681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.28D0, 0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 45781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.0D0, 0.04D0, 0.0D0, 0.0D0, 0.0D0, 45881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.0D0, 0.0D0, 0.7D0, -1.08D0, 0.0D0, 45981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.64D0, -1.26D0, 46081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.54D0, 0.20D0, 0.0D0, 0.0D0, 0.0D0, 0.5D0, 46181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 46281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.04D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 46381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.04D0, -0.9D0, 0.18D0, 0.0D0, 0.0D0, 46481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.0D0, 0.04D0, -0.9D0, 0.18D0, 0.7D0, 46581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + -0.18D0, 0.2D0, 0.16D0/ 46681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DATA SSIZE2/0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 46781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 46881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 0.0D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0, 46981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 1.17D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0, 47081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + 1.17D0, 1.17D0, 1.17D0/ 47181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Executable Statements .. 47281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 47381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 60 KI = 1, 4 47481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INCX = INCXS(KI) 47581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INCY = INCYS(KI) 47681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MX = ABS(INCX) 47781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MY = ABS(INCY) 47881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 47981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 40 KN = 1, 4 48081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray N = NS(KN) 48181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray KSIZE = MIN(2,KN) 48281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LENX = LENS(KN,MX) 48381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LENY = LENS(KN,MY) 48481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 48581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF (ICASE.EQ.4) THEN 48681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. DROTTEST .. 48781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 20 I = 1, 7 48881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray SX(I) = DX1(I) 48981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray SY(I) = DY1(I) 49081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray STX(I) = DT9X(I,KN,KI) 49181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray STY(I) = DT9Y(I,KN,KI) 49281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 20 CONTINUE 49381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL DROTTEST(N,SX,INCX,SY,INCY,SC,SS) 49481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL STEST(LENX,SX,STX,SSIZE2(1,KSIZE),SFAC) 49581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL STEST(LENY,SY,STY,SSIZE2(1,KSIZE),SFAC) 49681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 49781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE (NOUT,*) ' Shouldn''t be here in CHECK3' 49881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray STOP 49981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 50081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 40 CONTINUE 50181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 60 CONTINUE 50281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 50381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPC(1) = 1 50481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 80 I = 2, 11 50581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPC(I) = 0 50681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 80 CONTINUE 50781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPS(1) = 0.0 50881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 100 I = 2, 6 50981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPS(I) = 1.0 51081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 100 CONTINUE 51181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 120 I = 7, 11 51281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPS(I) = -1.0 51381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 120 CONTINUE 51481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPINX(1) = 1 51581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPINX(2) = 1 51681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPINX(3) = 1 51781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPINX(4) = -1 51881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPINX(5) = 1 51981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPINX(6) = -1 52081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPINX(7) = 1 52181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPINX(8) = 1 52281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPINX(9) = -1 52381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPINX(10) = 1 52481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPINX(11) = -1 52581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPINY(1) = 1 52681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPINY(2) = 1 52781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPINY(3) = -1 52881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPINY(4) = -1 52981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPINY(5) = 2 53081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPINY(6) = 1 53181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPINY(7) = 1 53281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPINY(8) = -1 53381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPINY(9) = -1 53481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPINY(10) = 2 53581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPINY(11) = 1 53681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 140 I = 1, 11 53781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPN(I) = 5 53881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 140 CONTINUE 53981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPN(5) = 3 54081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPN(10) = 3 54181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 160 I = 1, 5 54281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPX(I) = I 54381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPY(I) = I 54481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPTX(1,I) = I 54581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPTY(1,I) = I 54681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPTX(2,I) = I 54781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPTY(2,I) = -I 54881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPTX(3,I) = 6 - I 54981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPTY(3,I) = I - 6 55081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPTX(4,I) = I 55181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPTY(4,I) = -I 55281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPTX(6,I) = 6 - I 55381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPTY(6,I) = I - 6 55481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPTX(7,I) = -I 55581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPTY(7,I) = I 55681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPTX(8,I) = I - 6 55781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPTY(8,I) = 6 - I 55881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPTX(9,I) = -I 55981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPTY(9,I) = I 56081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPTX(11,I) = I - 6 56181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPTY(11,I) = 6 - I 56281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 160 CONTINUE 56381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPTX(5,1) = 1 56481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPTX(5,2) = 3 56581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPTX(5,3) = 5 56681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPTX(5,4) = 4 56781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPTX(5,5) = 5 56881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPTY(5,1) = -1 56981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPTY(5,2) = 2 57081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPTY(5,3) = -2 57181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPTY(5,4) = 4 57281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPTY(5,5) = -3 57381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPTX(10,1) = -1 57481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPTX(10,2) = -3 57581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPTX(10,3) = -5 57681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPTX(10,4) = 4 57781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPTX(10,5) = 5 57881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPTY(10,1) = 1 57981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPTY(10,2) = 2 58081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPTY(10,3) = 2 58181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPTY(10,4) = 4 58281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPTY(10,5) = 3 58381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 200 I = 1, 11 58481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INCX = MWPINX(I) 58581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INCY = MWPINY(I) 58681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 180 K = 1, 5 58781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray COPYX(K) = MWPX(K) 58881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray COPYY(K) = MWPY(K) 58981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPSTX(K) = MWPTX(I,K) 59081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MWPSTY(K) = MWPTY(I,K) 59181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 180 CONTINUE 59281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL DROTTEST(MWPN(I),COPYX,INCX,COPYY,INCY,MWPC(I),MWPS(I)) 59381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL STEST(5,COPYX,MWPSTX,MWPSTX,SFAC) 59481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL STEST(5,COPYY,MWPSTY,MWPSTY,SFAC) 59581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 200 CONTINUE 59681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray RETURN 59781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END 59881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray SUBROUTINE STEST(LEN,SCOMP,STRUE,SSIZE,SFAC) 59981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* ********************************* STEST ************************** 60081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 60181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* THIS SUBR COMPARES ARRAYS SCOMP() AND STRUE() OF LENGTH LEN TO 60281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* SEE IF THE TERM BY TERM DIFFERENCES, MULTIPLIED BY SFAC, ARE 60381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* NEGLIGIBLE. 60481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 60581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* C. L. LAWSON, JPL, 1974 DEC 10 60681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 60781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Parameters .. 60881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER NOUT 60981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray PARAMETER (NOUT=6) 61081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Scalar Arguments .. 61181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION SFAC 61281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER LEN 61381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Array Arguments .. 61481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION SCOMP(LEN), SSIZE(LEN), STRUE(LEN) 61581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Scalars in Common .. 61681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER ICASE, INCX, INCY, MODE, N 61781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LOGICAL PASS 61881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Local Scalars .. 61981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION SD 62081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER I 62181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. External Functions .. 62281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION SDIFF 62381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray EXTERNAL SDIFF 62481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Intrinsic Functions .. 62581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTRINSIC ABS 62681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Common blocks .. 62781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS 62881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Executable Statements .. 62981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 63081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 40 I = 1, LEN 63181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray SD = SCOMP(I) - STRUE(I) 63281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF (SDIFF(ABS(SSIZE(I))+ABS(SFAC*SD),ABS(SSIZE(I))).EQ.0.0D0) 63381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + GO TO 40 63481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 63581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* HERE SCOMP(I) IS NOT CLOSE TO STRUE(I). 63681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 63781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF ( .NOT. PASS) GO TO 20 63881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* PRINT FAIL MESSAGE AND HEADER. 63981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray PASS = .FALSE. 64081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE (NOUT,99999) 64181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE (NOUT,99998) 64281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 20 WRITE (NOUT,99997) ICASE, N, INCX, INCY, MODE, I, SCOMP(I), 64381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + STRUE(I), SD, SSIZE(I) 64481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 40 CONTINUE 64581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray RETURN 64681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 64781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray99999 FORMAT (' FAIL') 64881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray99998 FORMAT (/' CASE N INCX INCY MODE I ', 64981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + ' COMP(I) TRUE(I) DIFFERENCE', 65081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + ' SIZE(I)',/1X) 65181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray99997 FORMAT (1X,I4,I3,3I5,I3,2D36.8,2D12.4) 65281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END 65381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray SUBROUTINE STEST1(SCOMP1,STRUE1,SSIZE,SFAC) 65481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* ************************* STEST1 ***************************** 65581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 65681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* THIS IS AN INTERFACE SUBROUTINE TO ACCOMODATE THE FORTRAN 65781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* REQUIREMENT THAT WHEN A DUMMY ARGUMENT IS AN ARRAY, THE 65881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* ACTUAL ARGUMENT MUST ALSO BE AN ARRAY OR AN ARRAY ELEMENT. 65981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 66081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* C.L. LAWSON, JPL, 1978 DEC 6 66181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 66281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Scalar Arguments .. 66381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION SCOMP1, SFAC, STRUE1 66481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Array Arguments .. 66581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION SSIZE(*) 66681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Local Arrays .. 66781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION SCOMP(1), STRUE(1) 66881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. External Subroutines .. 66981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray EXTERNAL STEST 67081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Executable Statements .. 67181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 67281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray SCOMP(1) = SCOMP1 67381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray STRUE(1) = STRUE1 67481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL STEST(1,SCOMP,STRUE,SSIZE,SFAC) 67581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 67681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray RETURN 67781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END 67881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION FUNCTION SDIFF(SA,SB) 67981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* ********************************* SDIFF ************************** 68081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* COMPUTES DIFFERENCE OF TWO NUMBERS. C. L. LAWSON, JPL 1974 FEB 15 68181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 68281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Scalar Arguments .. 68381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION SA, SB 68481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Executable Statements .. 68581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray SDIFF = SA - SB 68681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray RETURN 68781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END 68881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray SUBROUTINE ITEST1(ICOMP,ITRUE) 68981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* ********************************* ITEST1 ************************* 69081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 69181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* THIS SUBROUTINE COMPARES THE VARIABLES ICOMP AND ITRUE FOR 69281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* EQUALITY. 69381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* C. L. LAWSON, JPL, 1974 DEC 10 69481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 69581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Parameters .. 69681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER NOUT 69781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray PARAMETER (NOUT=6) 69881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Scalar Arguments .. 69981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER ICOMP, ITRUE 70081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Scalars in Common .. 70181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER ICASE, INCX, INCY, MODE, N 70281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LOGICAL PASS 70381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Local Scalars .. 70481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER ID 70581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Common blocks .. 70681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS 70781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Executable Statements .. 70881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 70981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF (ICOMP.EQ.ITRUE) GO TO 40 71081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 71181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* HERE ICOMP IS NOT EQUAL TO ITRUE. 71281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 71381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF ( .NOT. PASS) GO TO 20 71481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* PRINT FAIL MESSAGE AND HEADER. 71581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray PASS = .FALSE. 71681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE (NOUT,99999) 71781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE (NOUT,99998) 71881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 20 ID = ICOMP - ITRUE 71981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE (NOUT,99997) ICASE, N, INCX, INCY, MODE, ICOMP, ITRUE, ID 72081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 40 CONTINUE 72181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray RETURN 72281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 72381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray99999 FORMAT (' FAIL') 72481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray99998 FORMAT (/' CASE N INCX INCY MODE ', 72581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + ' COMP TRUE DIFFERENCE', 72681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray + /1X) 72781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray99997 FORMAT (1X,I4,I3,3I5,2I36,I12) 72881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END 729