C ALGORITHM 692, COLLECTED ALGORITHMS FROM ACM. C THIS WORK PUBLISHED IN TRANSACTIONS ON MATHEMATICAL SOFTWARE, C VOL. 17, NO. 2, PP. 264-272. JUNE, 1991. DISTRIBUTION OF SOURCE CODE FOR THE SPARSE BLAS The sparse BLAS source code consists of the test program and model implementation for each of the three floating point precisions available in FORTRAN-77 (REAL, DOUBLE PRECISION, and COMPLEX) and the commonly supplied extension COMPLEX*16. In addition to the source code there are input files for each of the four test programs. The source code for the sparse BLAS is distributed on two floppy disks. The first floppy disk contains the source code and input files for the REAL and COMPLEX versions as well as this file (README.DOC). The second floppy disk contains the source code for the DOUBLE PRECISION and COMPLEX*16 versions. The files on the first disk are: STSTDRV.FOR Test program for certification of REAL version SSPBLAS.FOR REAL version of sparse BLAS subroutines STSTDRV.INP Input dataset for REAL certification CTSTDRV.FOR Test program for certification of COMPLEX version CSPBLAS.FOR COMPLEX version of sparse BLAS subroutines CTSTDRV.INP Input dataset for COMPLEX certification README.DOC This file The files on the second disk are: DTSTDRV.FOR Test program for certification of D. P. version DSPBLAS.FOR D. P. version of sparse BLAS subroutines DTSTDRV.INP Input dataset for DOUBLE PRECISION certification ZTSTDRV.FOR Test program for certification of COMPLEX*16 version ZSPBLAS.FOR COMPLEX*16 version of sparse BLAS subroutines ZTSTDRV.INP Input dataset for COMPLEX*16 certification To certify the REAL version, compile and link STSTDRV.FOR+SSPBLAS.FOR and execute with STSTDRV.INP. To certify the DOUBLE PRECISION version, compile and link DTSTDRV.FOR +DSPBLAS.FOR and execute with DTSTDRV.INP. To certify the COMPLEX version, compile and link CTSTDRV.FOR+CSPBLAS.FOR and execute with CTSTDRV.INP. To certify the COMPLEX*16 version, compile and link ZTSTDRV.FOR+ZSPBLAS.FOR and execute with ZTSTDRV.INP. The following table indicates certifications performed to date. Entries with P all passed certification with default settings for compilation and execution. Entries with PNO passed certification only when compiler optimization was turned off. Other entries indicate failure due to an identifable flaw in the complier. REAL D.P. COMPLEX COMPLEX*16 Alliant (v. 4.0.0) P P P 2 CDC 760 (FTN 5.1) P P P -na- CONVEX C1 (v. 2.0) P P P P Cray X-MP (CFT 1.14) P P P P IBM 3081 (FORT-V 1.4.1) P P P P IBM PC XT Microsoft (v. 4.0) P P P PNO Leahy (v. 2.20) P P 1 1 MicroVax-VMS (v. 4.4) P P P P MicroVax-Ultrix (v. 1.2) P P P P SCS-40 (CFT 1.13) P P P P SUN 3/260 (v. 3.4) P P P P VAX 780 (v. 4.5) P P P P 1 - compiler aborted with internal error 2 - altered input array Y for subprograms ZDOTCI, ZDOTUI, and ZGTHR for some vector lengths. Otherwise the results were correct. Failure reported to Alliant. PROGRAM TSSPBL C C C ================================================================== C ================================================================== C ==== TSSPBL -- CERTIFY REAL SPARSE BLAS ==== C ================================================================== C ================================================================== C C TSSPBL IS THE CERTIFICATION PROGRAM FOR THE REAL SPARSE BLAS. C THE APPROACH USED TO CERTIFY THE SPARSE BLAS IS AS FOLLOWS: C C 1. READ IN USER SPECIFIED INPUT ON OUTPUT UNIT, THRESHOLD VALUE C FOR TEST RATIO, AND THE SPECIFICATIONS FOR NZ, A, C AND S. C 2. VERIFY THE CORRECTNESS OF THE USER SPECIFIED INPUT AND C ECHO TO THE OUTPUT UNIT. C 3. FOR EACH SUBPROGRAM IN THE REAL SPARSE BLAS C PERFORM ALL THE USER SPECIFIED TESTS AND PRINT A PASS/FAIL C MESSAGE. TESTS WHICH FAIL GENERATE ADDITIONAL OUTPUT. C C SPARSE BLAS SUBPROGRAMS WHICH ARE CERTIFIED BY THIS PROGRAM ARE C C SAXPYI SGTHR SROTI C SDOTI SGTHRZ SSCTR C C THIS PROGRAM REQUIRES AN INPUT FILE ASSIGNED TO UNIT NIN C (CURRENTLY SET TO 5 BY A PARAMETER STATEMENT). THE DATA ON C THIS INPUT FILE CONTROLS THE OUTPUT UNIT, THE THRESHOLD VALUE C FOR THE NUMERICAL TESTING, AND THE SPECIFICATIONS FOR THE C TEST VALUES FOR THE LENGTH OF THE SPARSE VECTORS AND THE SCALARS C USED BY THE VARIOUS SUBPROGRAMS. AN EXAMPLE OF THE INPUT FILE C FOLLOWS C C LINE 1 'SBLATS.SUMM' NAME OF OUTPUT FILE C LINE 2 6 UNIT NUMBER OF OUTPUT FILE C LINE 3 100 MAX. NO. OF PRINTED ERROR MESSAGES C LINE 4 5.0 THRESHOLD VALUE OF TEST RATIO C LINE 5 16 NUMBER OF VALUES OF NZ C LINE 6 -1 0 1 2 5 9 31 32 33 63 64 65 127 128 129 257 C VALUES OF NZ C LINE 7 3 NUMBER OF VALUES OF A FOR -AXPYI C LINE 8 0.0 1.0 0.7 VALUES OF A C LINE 9 4 NUMBER OF VALUES OF C,S FOR -ROTI C LINE 10 1. 0. -.6 .8 VALUES OF C C LINE 11 0. 1 .8 -.6 VALUES OF S C C C THIS INPUT FILE IS READ USING FORTRAN-77 STANDARD LIST DIRECTED C INPUT. SINGLE QUOTES ARE REQUIRED AROUND THE NAME OF THE OUTPUT C FILE ON LINE 1. THE NUMBERS ON LINES 6, 8, 10, AND 11 CAN BE C DELIMITED BY BLANKS OR COMMAS. C C THIS PROGRAM WAS WRITTEN BY ROGER G. GRIMES, BOEING C COMPUTER SERVICES, BELLEVUE, WA. DURING APRIL, 1987. C C ================================================================== C C ------------------------------------ C ... PROBLEM SPECIFICATION PARAMETERS C ------------------------------------ C C NIN INPUT UNIT C NZMAX MAXIMUM VALUE OF ANY SINGLE NZ C NNZMAX MAXIMUM NUMBER OF VALUES OF NZ C NAMAX MAXIMUM NUMBER OF VALUES OF A (-AXPYI C SCALAR) C NGMAX MAXIMUM NUMBER OF VALUES OF C AND S C (-ROTI SCALARS FOR GIVENS ROTATION) C C ================================================================== C INTEGER NIN, NZMAX, NNZMAX, NAMAX, NGMAX C PARAMETER ( NIN = 5, NZMAX = 320, 1 NNZMAX = 24, NAMAX = 7, NGMAX = 7 ) C C ----------------------- C ... COMPUTED PARAMETERS C ----------------------- C INTEGER NZMAX2 C PARAMETER ( NZMAX2 = 2 * NZMAX ) C C ================================================================== C C ------------------------ C ... VARIABLE DECLARATION C ------------------------ C CHARACTER*32 NAMOUT C INTEGER ERRCNT, ERRMAX, I, NOUT, NUMA, 1 NUMG, NUMNZ C INTEGER INDX (NZMAX2), INDXT (NZMAX2), 1 LIST (NZMAX2), NZVALU(NNZMAX) C REAL EPSILN, EPSSAV, THRESH C REAL X (NZMAX2), Y (NZMAX2), 1 XTRUE (NZMAX2), YTRUE (NZMAX2), 2 XSAVE (NZMAX2), YSAVE (NZMAX2), 3 AVALUE(NAMAX), CVALUE(NGMAX), 4 SVALUE(NGMAX) C C -------------------- C ... SUBPROGRAMS USED C -------------------- C REAL SDIFF C EXTERNAL TSXPYI, TSDOTI, TSGTHR, TSGTHZ, TSROTI, 1 TSSCTR, SDIFF C C ================================================================== C ERRCNT = 0 C C ------------------------------------------------ C ... READ IN USER SPECIFIED INPUT FOR OUTPUT UNIT C ------------------------------------------------ C READ ( NIN, * ) NAMOUT READ ( NIN, * ) NOUT C C -------------------- C ... OPEN OUTPUT UNIT C -------------------- C OPEN ( UNIT = NOUT, FILE = NAMOUT, STATUS = 'NEW' ) C C ------------------------------ C ... READ IN REMAINDER OF INPUT C ------------------------------ C READ ( NIN, * ) ERRMAX READ ( NIN, * ) THRESH READ ( NIN, * ) NUMNZ C IF ( NUMNZ .GT. NNZMAX ) THEN ERRCNT = 1 WRITE ( NOUT, 1100 ) NUMNZ, NNZMAX GO TO 900 END IF C READ ( NIN, * ) ( NZVALU(I), I = 1, NUMNZ ) C READ ( NIN, * ) NUMA C IF ( NUMA .GT. NAMAX ) THEN ERRCNT = 1 WRITE ( NOUT, 1110 ) NUMA, NAMAX GO TO 900 END IF C READ ( NIN, * ) ( AVALUE(I), I = 1, NUMA ) C READ ( NIN, * ) NUMG C IF ( NUMG .GT. NGMAX ) THEN ERRCNT = 1 WRITE ( NOUT, 1120 ) NUMG, NGMAX GO TO 900 END IF C READ ( NIN, * ) ( CVALUE(I), I = 1, NUMG ) READ ( NIN, * ) ( SVALUE(I), I = 1, NUMG ) C C ------------------------------ C ... PRINT USER SPECIFIED INPUT C ------------------------------ C WRITE ( NOUT, 1000 ) NAMOUT, NOUT, ERRMAX, THRESH WRITE ( NOUT, 1010 ) NUMNZ WRITE ( NOUT, 1020 ) ( NZVALU(I), I = 1, NUMNZ ) WRITE ( NOUT, 1030 ) NUMA WRITE ( NOUT, 1040 ) ( AVALUE(I), I = 1, NUMA ) WRITE ( NOUT, 1050 ) NUMG WRITE ( NOUT, 1060 ) ( CVALUE(I), I = 1, NUMG ) WRITE ( NOUT, 1070 ) ( SVALUE(I), I = 1, NUMG ) C C ------------------------------- C ... VERIFY USER SPECIFIED INPUT C ------------------------------- C IF ( THRESH .LE. 0.0E0 ) THEN WRITE ( NOUT, 1130 ) THRESH THRESH = 10.0E0 END IF C IF ( NUMNZ .LE. 0 ) THEN WRITE ( NOUT, 1140 ) NUMNZ ERRCNT = 1 END IF C DO 100 I = 1, NUMNZ IF ( NZVALU(I) .GT. NZMAX ) THEN WRITE ( NOUT, 1150 ) I, NZVALU(I), NZMAX NZVALU(I) = NZMAX END IF 100 CONTINUE C IF ( ERRCNT .NE. 0 ) GO TO 900 C C --------------------------- C ... COMPUTE MACHINE EPSILON C --------------------------- C EPSILN = 1.0E0 EPSSAV = 1.0E0 C 200 IF ( SDIFF ( 1.0E0 + EPSILN, 1.0E0 ) .EQ. 0.0E0 ) GO TO 210 C EPSSAV = EPSILN EPSILN = EPSILN * .5E0 GO TO 200 C 210 EPSILN = EPSSAV C C ================================================================== C C ----------------------------- C ... TEST THE REAL SPARSE BLAS C ----------------------------- C C ------------------ C ... CERTIFY SAXPYI C ------------------ C CALL TSXPYI ( NOUT, EPSILN, THRESH, NZMAX2, 1 NUMNZ, NZVALU, NUMA, AVALUE, 2 X, XSAVE, XTRUE, Y, YSAVE, YTRUE, 3 INDX, INDXT, LIST, ERRCNT, ERRMAX ) C C ----------------- C ... CERTIFY SDOTI C ----------------- C CALL TSDOTI ( NOUT, EPSILN, THRESH, NZMAX2, 1 NUMNZ, NZVALU, 2 X, XSAVE, XTRUE, Y, YSAVE, YTRUE, 3 INDX, INDXT, ERRCNT, ERRMAX ) C C ----------------- C ... CERTIFY SGTHR C ----------------- C CALL TSGTHR ( NOUT, NZMAX2, NUMNZ, NZVALU, 1 X, XSAVE, XTRUE, Y, YSAVE, YTRUE, 2 INDX, INDXT, ERRCNT, ERRMAX ) C C ------------------ C ... CERTIFY SGTHRZ C ------------------ C CALL TSGTHZ ( NOUT, NZMAX2, NUMNZ, NZVALU, 1 X, XSAVE, XTRUE, Y, YSAVE, YTRUE, 2 INDX, INDXT, ERRCNT, ERRMAX ) C C ----------------- C ... CERTIFY SROTI C ----------------- C CALL TSROTI ( NOUT, EPSILN, THRESH, NZMAX2, 1 NUMNZ, NZVALU, NUMG, CVALUE, SVALUE, 2 X, XSAVE, XTRUE, Y, YSAVE, YTRUE, 3 INDX, INDXT, LIST, ERRCNT, ERRMAX ) C C ----------------- C ... CERTIFY SSCTR C ----------------- C CALL TSSCTR ( NOUT, NZMAX2, NUMNZ, NZVALU, 1 X, XSAVE, XTRUE, Y, YSAVE, YTRUE, 2 INDX, INDXT, ERRCNT, ERRMAX ) C C ================================================================== C C ------------------------------------- C ... PRINT GLOBAL PASS OR FAIL MESSAGE C ------------------------------------- C 900 IF ( ERRCNT .EQ. 0 ) THEN WRITE ( NOUT, 2000 ) ELSE WRITE ( NOUT, 2100 ) ERRCNT END IF C C ----------------------------------------- C ... END OF CERTIFICATION PROGRAM FOR REAL C SPARSE BLAS C ----------------------------------------- C STOP C C ================================================================== C C ----------- C ... FORMATS C ----------- C 1000 FORMAT( '1' /// 1 5X, 'START OF CERTIFICATION PROGRAM FOR THE REAL ', 2 'SPARSE BLAS' 3 /5X, '--------------------------------------------', 4 '-----------' 5 //5X, 'NAME OF OUTPUT UNIT = ', A 6 /5X, 'NUMBER OF OUTPUT UNIT = ', I10 7 /5X, 'MAX. NO. OF PRINTED ERROR MESSAGES = ', I10 8 /5X, 'THRESHOLD VALUE OF TEST RATIO = ', F10.1 ) C 1010 FORMAT ( /5X, 'NUMBER OF VALUES OF NZ = ', I10 ) C 1020 FORMAT ( /5X, 'VALUES OF NZ = ', 10I5 ) C 1030 FORMAT ( /5X, 'NUMBER OF VALUES OF A = ', I10 ) C 1040 FORMAT ( /5X, 'VALUES OF A = ', 1P, 5E13.4 ) C 1050 FORMAT ( /5X, 'NUMBER OF VALUES OF C AND S = ', I10 ) C 1060 FORMAT ( /5X, 'VALUES OF C = ', 1P, 5E13.4 ) C 1070 FORMAT ( /5X, 'VALUES OF S = ', 1P, 5E13.4 ) C 1100 FORMAT ( /5X, 'USER SPECIFIED NUMBER OF TEST CASES FOR THE ', 1 'NUMBER OF NONZEROES EXCEEDS PROGRAM LIMIT.' 2 /5X, 'NUMBER SPECIFIED = ', I10, 2X, 'PROGRAM LIMIT =', 3 I10 ) C 1110 FORMAT ( /5X, 'USER SPECIFIED NUMBER OF TEST CASES FOR THE ', 1 'SCALAR A EXCEEDS PROGRAM LIMIT.' 2 /5X, 'NUMBER SPECIFIED = ', I10, 2X, 'PROGRAM LIMIT =', 3 I10 ) C 1120 FORMAT ( /5X, 'USER SPECIFIED NUMBER OF TEST CASES FOR THE ', 1 'SCALARS C AND S EXCEEDS PROGRAM LIMIT.' 2 /5X, 'NUMBER SPECIFIED = ', I10, 2X, 'PROGRAM LIMIT =', 3 I10 ) C 1130 FORMAT ( /5X, 'USER SPECIFIED VALUE FOR THRESHOLD IS ', 1PE15.5, 1 ' WHICH IS NONPOSITIVE. IT HAS BEEN RESET TO 10.') C 1140 FORMAT ( /5X, 'USER SPECIFIED NUMBER OF VALUES OF NZ IS ', I5, 1 ' WHICH IS NONPOSITIVE. NO TESTING WILL OCCUR.' ) C 1150 FORMAT ( /5X, 'THE ', I3, '-TH USER SPECIFIED VALUE OF NZ IS ', 1 I8, ' IS LARGER THAN THE MAXIMUM ALLOWABLE ', 2 'VALUE OF NZ. IT HAS BEEN RESET TO ', I5 ) C 2000 FORMAT ( /5X, 'REAL SPARSE BLAS HAVE PASSED ALL TESTS.' ) C 2100 FORMAT ( /5X, 'REAL SPARSE BLAS HAVE FAILED ', I10, 1 ' TESTS. SEE ABOVE PRINTED ERROR MESSAGES.' ) C C ================================================================== C END SUBROUTINE TSXPYI ( NOUT, EPSILN, THRESH, NZMAX2, 1 NUMNZ, NZVALU, NUMA, AVALUE, 2 X, XSAVE, XTRUE, Y, YSAVE, 3 YTRUE , INDX, INDXT, LIST, ERRCNT, 4 ERRMAX ) C C ================================================================== C ================================================================== C ==== TSXPYI -- CERTIFY SAXPYI ==== C ================================================================== C ================================================================== C C SUBROUTINE TSXPYI IS THE CERTIFICATION MODULE FOR THE SPARSE C BASIC LINEAR ALGEBRA SUBROUTINE MODULE SAXPYI. C C WRITTEN BY ROGER G GRIMES C APRIL 1987 C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER NOUT, NZMAX2, NUMNZ, NUMA, ERRCNT, 1 ERRMAX C INTEGER NZVALU (*), INDX (*), INDXT (*), 1 LIST (*) C REAL EPSILN, THRESH C REAL AVALUE (*), 1 X (*), XSAVE (*), XTRUE (*), 2 Y (*), YSAVE (*), YTRUE (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C REAL A, ATRUE, CLOBBR C INTEGER COUNT, I, ICLOBR, J, KA, 1 KINDX, KNZ, N, NZ, NZTRUE C REAL ERR, S, T C C -------------------- C ... SUBPROGRAMS USED C -------------------- C LOGICAL IVSAME, SVSAME C EXTERNAL ICOPY, SCOPY, IINIT, SINIT, GNINDX, 1 IVSAME, SVSAME, SAXPYI C C ================================================================== C C ------------------ C ... INITIALIZATION C ------------------ C COUNT = 0 C CLOBBR = -1.0E10 ICLOBR = -10000000 C C ------------------------------------ C ... GENERATE SOME VALUES FOR X AND Y C ------------------------------------ C DO 100 I = 1, NZMAX2 XSAVE(I) = COS ( .6*FLOAT(I) ) YSAVE(I) = SIN ( .7*FLOAT(I) ) 100 CONTINUE C C ------------------------ C ... FOR EACH VALUE OF NZ C ------------------------ C DO 700 KNZ = 1, NUMNZ C NZTRUE = NZVALU(KNZ) N = 2 * MAX ( NZTRUE, 1 ) C C ----------------------- C ... FOR EACH VALUE OF A C ----------------------- C DO 600 KA = 1, NUMA C ATRUE = AVALUE(KA) C C ------------------------------- C ... FOR EACH KIND OF INDX ARRAY C ------------------------------- C DO 500 KINDX = 1, 5 C CALL GNINDX ( NZTRUE, N, ICLOBR, KINDX, INDXT ) C CALL IINIT ( N, -1, LIST, 1 ) C DO 150 I = 1, NZTRUE LIST (INDXT(I)) = I 150 CONTINUE C C ----------------------- C ... GENERATE INPUT DATA C ----------------------- C I = MIN ( N, N-NZTRUE ) J = N - I + 1 CALL SCOPY ( NZTRUE, XSAVE, 1, XTRUE, 1 ) CALL SINIT ( I, CLOBBR, XTRUE(J), 1 ) CALL SINIT ( N, CLOBBR, YTRUE, 1 ) C DO 200 I = 1, NZTRUE YTRUE (INDXT(I)) = YSAVE (INDXT(I)) 200 CONTINUE C C ------------------- C ... COPY TRUE INPUT C ------------------- C A = ATRUE NZ = NZTRUE C CALL SCOPY ( N, YTRUE, 1, Y, 1 ) CALL SCOPY ( N, XTRUE, 1, X, 1 ) CALL ICOPY ( N, INDXT, 1, INDX, 1 ) C C -------------------------- C ... COMPUTE IN-LINE RESULT C -------------------------- C DO 300 I = 1, NZTRUE YTRUE (INDXT(I)) = YTRUE (INDXT(I)) + 1 ATRUE * XTRUE(I) 300 CONTINUE C C --------------- C ... CALL SAXPYI C --------------- C CALL SAXPYI ( NZ, A, X, INDX, Y ) C C ----------------------------------------- C ... TEST ARGUMENTS OF SAXPYI THAT ARE NOT C SUPPOSED TO CHANGE. C ----------------------------------------- C IF ( NZ .NE. NZTRUE ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1000 ) NZTRUE, ATRUE, KINDX, 1 NZ END IF END IF C IF ( A .NE. ATRUE ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1100 ) NZTRUE, ATRUE, KINDX, 1 A END IF END IF C IF ( .NOT. SVSAME ( N, X, XTRUE ) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1200 ) NZTRUE, ATRUE, KINDX END IF END IF C IF ( .NOT. IVSAME ( N, INDX, INDXT ) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1300 ) NZTRUE, ATRUE, KINDX END IF END IF C C --------------------------- C ... TEST OUTPUT FROM SAXPYI C --------------------------- C DO 400 J = 1, N IF ( LIST(J) .EQ. -1 ) THEN IF ( Y(J) .NE. YTRUE(J) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1400 ) NZTRUE, ATRUE, 1 KINDX, J, 2 Y(J), YTRUE(J) END IF END IF C ELSE C S = ABS ( Y(J) - YTRUE(J) ) T = ABS ( ATRUE) * ABS ( XTRUE (LIST(J))) + 1 ABS ( YSAVE(J)) ERR = S / ( EPSILN * T ) IF ( ERR .GT. THRESH ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1500 ) NZTRUE, ATRUE, 1 KINDX, J, Y(J), 2 YTRUE(J), ERR END IF END IF C END IF C 400 CONTINUE C 500 CONTINUE C 600 CONTINUE C 700 CONTINUE C C ================================================================== C C ------------------ C ... END OF TESTING C ------------------ C ERRCNT = ERRCNT + COUNT IF ( COUNT .NE. 0 ) GO TO 800 C C ----------------------------------- C ... WRITE PASSED MESSAGE AND RETURN C ----------------------------------- C WRITE ( NOUT, 2700 ) GO TO 900 C C ----------------------------------- C ... WRITE FAILED MESSAGE AND RETURN C ----------------------------------- C 800 WRITE ( NOUT, 2800 ) COUNT C C ------------------------ C ... END OF MODULE TSXPYI C ------------------------ C 900 CONTINUE RETURN C C ================================================================== C C ----------- C ... FORMATS C ----------- C 1000 FORMAT ( 5X, 'SAXPYI ALTERED NZ FOR TEST WITH NZ = ', I5, 1 ' A =', 1PE15.5, 2 ' AND THE INDX TYPE NO. ', I5, 3 '. ALTERED VALUE OF NZ = ', I5 ) C 1100 FORMAT ( 5X, 'SAXPYI ALTERED A FOR TEST WITH NZ = ', I5, 1 ' A =', 1PE15.5, 2 ' AND THE INDX TYPE NO. ', I5, 3 '. ALTERED VALUE OF A =', 1PE15.5 ) C 1200 FORMAT ( 5X, 'SAXPYI ALTERED ARRAY X FOR TEST WITH NZ = ', I5, 1 ' A =', 1PE15.5, 2 ' AND THE INDX TYPE NO. ', I5 ) C 1300 FORMAT ( 5X, 'SAXPYI ALTERED ARRAY INDX FOR TEST WITH NZ = ', I5, 1 ' A =', 1PE15.5, 2 ' AND THE INDX TYPE NO. ', I5 ) C 1400 FORMAT ( 5X, 'SAXPYI OUTPUT ARRAY Y IS INCORRECT FOR TEST WITH ', 1 'NZ = ', I5, ' A =', 1PE15.5, 2 ' AND THE INDX TYPE NO. ', I5 3 /5X, 'INCORRECT COMPONENT NO. ', I5, ' HAS VALUE =', 4 1PE15.5, 5 ' TRUE VALUE =', 1PE15.5 ) C 1500 FORMAT ( 5X, 'SAXPYI OUTPUT ARRAY Y IS INACCURATE FOR TEST WITH ', 1 'NZ = ', I5, ' A =', 1PE15.5, 2 ' AND THE INDX TYPE NO. ', I5 3 /5X, 'INACCURATE COMPONENT NO. ', I5, ' HAS VALUE =', 4 1PE15.5, ' TRUE VALUE =', 5 1PE15.5, ' ERROR = ', 1PE12.1 ) C 2700 FORMAT ( /5X, 'SAXPYI PASSED ALL TESTS.' ) C 2800 FORMAT ( /5X, 'SAXPYI FAILED', I10, ' TESTS.' ) C C ================================================================== C END SUBROUTINE TSDOTI ( NOUT, EPSILN, THRESH, NZMAX2, 1 NUMNZ, NZVALU, 2 X, XSAVE, XTRUE, Y, YSAVE, 3 YTRUE , INDX, INDXT, ERRCNT, ERRMAX ) C C ================================================================== C ================================================================== C ==== TSDOTI -- CERTIFY SDOTI ==== C ================================================================== C ================================================================== C C SUBROUTINE TSDOTI IS THE CERTIFICATION MODULE FOR THE SPARSE C BASIC LINEAR ALGEBRA SUBROUTINE MODULE SDOTI. C C WRITTEN BY ROGER G GRIMES C APRIL 1987 C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER NOUT, NZMAX2, NUMNZ, ERRCNT, 1 ERRMAX C INTEGER NZVALU (*), INDX (*), INDXT (*) C REAL EPSILN, THRESH C REAL X (*), XSAVE (*), XTRUE (*), 1 Y (*), YSAVE (*), YTRUE (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER COUNT, I, ICLOBR, J, KINDX, 1 KNZ, N, NZ, NZTRUE C REAL ERR, S, T C REAL CLOBBR, V, W C C -------------------- C ... SUBPROGRAMS USED C -------------------- C LOGICAL IVSAME, SVSAME C REAL SDOTI C EXTERNAL ICOPY, SCOPY, SINIT, GNINDX, 1 IVSAME, SVSAME, SDOTI C C ================================================================== C C ------------------ C ... INITIALIZATION C ------------------ C COUNT = 0 C CLOBBR = -1.0E10 ICLOBR = -10000000 C C ------------------------------------ C ... GENERATE SOME VALUES FOR X AND Y C ------------------------------------ C DO 100 I = 1, NZMAX2 XSAVE(I) = COS ( .6*FLOAT(I) ) YSAVE(I) = SIN ( .7*FLOAT(I) ) 100 CONTINUE C C ------------------------ C ... FOR EACH VALUE OF NZ C ------------------------ C DO 600 KNZ = 1, NUMNZ C NZTRUE = NZVALU(KNZ) N = 2 * MAX ( NZTRUE, 1 ) C C ------------------------------- C ... FOR EACH KIND OF INDX ARRAY C ------------------------------- C DO 500 KINDX = 1, 5 C CALL GNINDX ( NZTRUE, N, ICLOBR, KINDX, INDXT ) C C ----------------------- C ... GENERATE INPUT DATA C ----------------------- C I = MIN ( N, N-NZTRUE ) J = N - I + 1 CALL SCOPY ( NZTRUE, XSAVE, 1, XTRUE, 1 ) CALL SINIT ( I, CLOBBR, XTRUE(J), 1 ) CALL SINIT ( N, CLOBBR, YTRUE, 1 ) C DO 200 I = 1, NZTRUE YTRUE (INDXT(I)) = YSAVE (INDXT(I)) 200 CONTINUE C C ------------------- C ... COPY TRUE INPUT C ------------------- C NZ = NZTRUE C CALL SCOPY ( N, YTRUE, 1, Y, 1 ) CALL SCOPY ( N, XTRUE, 1, X, 1 ) CALL ICOPY ( N, INDXT, 1, INDX, 1 ) C C -------------------------- C ... COMPUTE IN-LINE RESULT C -------------------------- C V = 0.0E0 C DO 300 I = 1, NZTRUE V = V + XTRUE(I) * YTRUE (INDXT(I)) 300 CONTINUE C C -------------- C ... CALL SDOTI C -------------- C W = SDOTI ( NZ, X, INDX, Y ) C C ---------------------------------------- C ... TEST ARGUMENTS OF SDOTI THAT ARE NOT C SUPPOSED TO CHANGE. C ---------------------------------------- C IF ( NZ .NE. NZTRUE ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1000 ) NZTRUE, KINDX, NZ END IF END IF C IF ( .NOT. SVSAME ( N, X, XTRUE ) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1100 ) NZTRUE, KINDX END IF END IF C IF ( .NOT. IVSAME ( N, INDX, INDXT ) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1200 ) NZTRUE, KINDX END IF END IF C IF ( .NOT. SVSAME ( N, Y, YTRUE ) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1300 ) NZTRUE, KINDX END IF END IF C C -------------------------- C ... TEST OUTPUT FROM SDOTI C -------------------------- C S = ABS ( V - W ) C T = 0.0E0 DO 400 I = 1, NZTRUE T = T + ABS ( XTRUE(I) * YTRUE (INDXT(I)) ) 400 CONTINUE C IF ( T .EQ. 0.0E0 ) T = 1.0E0 C ERR = S / ( EPSILN * T ) C IF ( ERR .GT. THRESH ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1400 ) NZTRUE, KINDX, 1 W, V, ERR END IF END IF C 500 CONTINUE C 600 CONTINUE C C ================================================================== C C ------------------ C ... END OF TESTING C ------------------ C ERRCNT = ERRCNT + COUNT IF ( COUNT .NE. 0 ) GO TO 800 C C ----------------------------------- C ... WRITE PASSED MESSAGE AND RETURN C ----------------------------------- C WRITE ( NOUT, 2700 ) GO TO 900 C C ----------------------------------- C ... WRITE FAILED MESSAGE AND RETURN C ----------------------------------- C 800 WRITE ( NOUT, 2800 ) COUNT C C ------------------------ C ... END OF MODULE TSDOTI C ------------------------ C 900 CONTINUE RETURN C C ================================================================== C C ----------- C ... FORMATS C ----------- C 1000 FORMAT ( 5X, 'SDOTI ALTERED NZ FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5, 2 '. ALTERED VALUE OF NZ = ', I5 ) C 1100 FORMAT ( 5X, 'SDOTI ALTERED ARRAY X FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5 ) C 1200 FORMAT ( 5X, 'SDOTI ALTERED ARRAY INDX FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5 ) C 1300 FORMAT ( 5X, 'SDOTI ALTERED ARRAY Y FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5 ) C 1400 FORMAT ( 5X, 'SDOTI OUTPUT W IS INACCURATE FOR TEST WITH ', 1 'NZ = ', I5, ' AND THE INDX TYPE NO. ', I5 2 /5X, 'SDOTI HAS VALUE =', 1PE15.5, 3 ' TRUE VALUE =', 1PE15.5, 4 ' ERROR = ', 1PE12.1 ) C 2700 FORMAT ( /5X, 'SDOTI PASSED ALL TESTS.' ) C 2800 FORMAT ( /5X, 'SDOTI FAILED', I10, ' TESTS.' ) C C ================================================================== C END SUBROUTINE TSGTHR ( NOUT, NZMAX2, NUMNZ, NZVALU, 1 X, XSAVE, XTRUE, Y, YSAVE, 2 YTRUE , INDX, INDXT, ERRCNT, ERRMAX ) C C ================================================================== C ================================================================== C ==== TSGTHR -- CERTIFY SGTHR ==== C ================================================================== C ================================================================== C C SUBROUTINE TSGTHR IS THE CERTIFICATION MODULE FOR THE SPARSE C BASIC LINEAR ALGEBRA SUBROUTINE MODULE SGTHR. C C WRITTEN BY ROGER G GRIMES C APRIL 1987 C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER NOUT, NZMAX2, NUMNZ, ERRCNT, 1 ERRMAX C INTEGER NZVALU (*), INDX (*), INDXT (*) C REAL X (*), XSAVE (*), XTRUE (*), 1 Y (*), YSAVE (*), YTRUE (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER COUNT, I, ICLOBR, KINDX, 1 KNZ, N, NZ, NZTRUE C REAL CLOBBR C C -------------------- C ... SUBPROGRAMS USED C -------------------- C LOGICAL IVSAME, SVSAME C EXTERNAL ICOPY, SCOPY, SINIT, GNINDX, 1 IVSAME, SVSAME, SGTHR C C ================================================================== C C ------------------ C ... INITIALIZATION C ------------------ C COUNT = 0 C CLOBBR = -1.0E10 ICLOBR = -10000000 C C ------------------------------------ C ... GENERATE SOME VALUES FOR X AND Y C ------------------------------------ C DO 100 I = 1, NZMAX2 XSAVE(I) = COS ( .6*FLOAT(I) ) YSAVE(I) = SIN ( .7*FLOAT(I) ) 100 CONTINUE C C ------------------------ C ... FOR EACH VALUE OF NZ C ------------------------ C DO 600 KNZ = 1, NUMNZ C NZTRUE = NZVALU(KNZ) N = 2 * MAX ( NZTRUE, 1 ) C C ------------------------------- C ... FOR EACH KIND OF INDX ARRAY C ------------------------------- C DO 500 KINDX = 1, 5 C CALL GNINDX ( NZTRUE, N, ICLOBR, KINDX, INDXT ) C C ----------------------- C ... GENERATE INPUT DATA C ----------------------- C CALL SINIT ( N, CLOBBR, XTRUE, 1 ) CALL SINIT ( N, CLOBBR, YTRUE, 1 ) C DO 200 I = 1, NZTRUE YTRUE (INDXT(I)) = YSAVE (INDXT(I)) 200 CONTINUE C C ------------------- C ... COPY TRUE INPUT C ------------------- C NZ = NZTRUE C CALL SCOPY ( N, YTRUE, 1, Y, 1 ) CALL SCOPY ( N, XTRUE, 1, X, 1 ) CALL ICOPY ( N, INDXT, 1, INDX, 1 ) C C -------------------------- C ... COMPUTE IN-LINE RESULT C -------------------------- C DO 300 I = 1, NZTRUE XTRUE (I) = YTRUE (INDXT(I)) 300 CONTINUE C C -------------- C ... CALL SGTHR C -------------- C CALL SGTHR ( NZ, Y, X, INDX ) C C ---------------------------------------- C ... TEST ARGUMENTS OF SGTHR THAT ARE NOT C SUPPOSED TO CHANGE. C ---------------------------------------- C IF ( NZ .NE. NZTRUE ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1000 ) NZTRUE, KINDX, NZ END IF END IF C IF ( .NOT. SVSAME ( N, Y, YTRUE ) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1100 ) NZTRUE, KINDX END IF END IF C IF ( .NOT. IVSAME ( N, INDX, INDXT ) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1200 ) NZTRUE, KINDX END IF END IF C C -------------------------- C ... TEST OUTPUT FROM SGTHR C -------------------------- C DO 400 I = 1, N IF ( X(I) .NE. XTRUE(I) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1300 ) NZTRUE, KINDX, I, 1 X(I), XTRUE(I) END IF END IF 400 CONTINUE C 500 CONTINUE C 600 CONTINUE C C ================================================================== C C ------------------ C ... END OF TESTING C ------------------ C ERRCNT = ERRCNT + COUNT IF ( COUNT .NE. 0 ) GO TO 800 C C ----------------------------------- C ... WRITE PASSED MESSAGE AND RETURN C ----------------------------------- C WRITE ( NOUT, 2700 ) GO TO 900 C C ----------------------------------- C ... WRITE FAILED MESSAGE AND RETURN C ----------------------------------- C 800 WRITE ( NOUT, 2800 ) COUNT C C ------------------------ C ... END OF MODULE TSGTHR C ------------------------ C 900 CONTINUE RETURN C C ================================================================== C C ----------- C ... FORMATS C ----------- C 1000 FORMAT ( 5X, 'SGTHR ALTERED NZ FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5, 2 '. ALTERED VALUE OF NZ = ', I5 ) C 1100 FORMAT ( 5X, 'SGTHR ALTERED ARRAY Y FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5 ) C 1200 FORMAT ( 5X, 'SGTHR ALTERED ARRAY INDX FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5 ) C 1300 FORMAT ( 5X, 'SGTHR OUTPUT ARRAY X IS INCORRECT FOR TEST WITH ', 1 'NZ = ', I5, ' AND THE INDX TYPE NO. ', I5 2 /5X, 'INACCURATE COMPONENT NO. ', I5, ' HAS VALUE =', 3 1PE15.5, ' TRUE VALUE = ', 1PE15.5 ) C 2700 FORMAT ( /5X, 'SGTHR PASSED ALL TESTS.' ) C 2800 FORMAT ( /5X, 'SGTHR FAILED', I10, ' TESTS.' ) C C ================================================================== C END SUBROUTINE TSGTHZ ( NOUT, NZMAX2, NUMNZ, NZVALU, 1 X, XSAVE, XTRUE, Y, YSAVE, 2 YTRUE , INDX, INDXT, ERRCNT, ERRMAX ) C C ================================================================== C ================================================================== C ==== TSGTHZ -- CERTIFY SGTHRZ ==== C ================================================================== C ================================================================== C C SUBROUTINE TSGTHZ IS THE CERTIFICATION MODULE FOR THE SPARSE C BASIC LINEAR ALGEBRA SUBROUTINE MODULE SGTHRZ. C C WRITTEN BY ROGER G GRIMES C APRIL 1987 C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER NOUT, NZMAX2, NUMNZ, ERRCNT, 1 ERRMAX C INTEGER NZVALU (*), INDX (*), INDXT (*) C REAL X (*), XSAVE (*), XTRUE (*), 1 Y (*), YSAVE (*), YTRUE (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER COUNT, I, ICLOBR, KINDX, 1 KNZ, N, NZ, NZTRUE C REAL CLOBBR C C -------------------- C ... SUBPROGRAMS USED C -------------------- C LOGICAL IVSAME, SVSAME C EXTERNAL ICOPY, SCOPY, SINIT, GNINDX, 1 IVSAME, SVSAME, SGTHRZ C C ================================================================== C C ------------------ C ... INITIALIZATION C ------------------ C COUNT = 0 C CLOBBR = -1.0E10 ICLOBR = -10000000 C C ------------------------------------ C ... GENERATE SOME VALUES FOR X AND Y C ------------------------------------ C DO 100 I = 1, NZMAX2 XSAVE(I) = COS ( .6*FLOAT(I) ) YSAVE(I) = SIN ( .7*FLOAT(I) ) 100 CONTINUE C C ------------------------ C ... FOR EACH VALUE OF NZ C ------------------------ C DO 600 KNZ = 1, NUMNZ C NZTRUE = NZVALU(KNZ) N = 2 * MAX ( NZTRUE, 1 ) C C ------------------------------- C ... FOR EACH KIND OF INDX ARRAY C ------------------------------- C DO 500 KINDX = 1, 5 C CALL GNINDX ( NZTRUE, N, ICLOBR, KINDX, INDXT ) C C ----------------------- C ... GENERATE INPUT DATA C ----------------------- C CALL SINIT ( N, CLOBBR, XTRUE, 1 ) CALL SINIT ( N, CLOBBR, YTRUE, 1 ) C DO 200 I = 1, NZTRUE YTRUE (INDXT(I)) = YSAVE (INDXT(I)) 200 CONTINUE C C ------------------- C ... COPY TRUE INPUT C ------------------- C NZ = NZTRUE C CALL SCOPY ( N, YTRUE, 1, Y, 1 ) CALL SCOPY ( N, XTRUE, 1, X, 1 ) CALL ICOPY ( N, INDXT, 1, INDX, 1 ) C C -------------------------- C ... COMPUTE IN-LINE RESULT C -------------------------- C DO 300 I = 1, NZTRUE XTRUE (I) = YTRUE (INDXT(I)) YTRUE(INDXT(I)) = 0.0E0 300 CONTINUE C C --------------- C ... CALL SGTHRZ C --------------- C CALL SGTHRZ ( NZ, Y, X, INDX ) C C ----------------------------------------- C ... TEST ARGUMENTS OF SGTHRZ THAT ARE NOT C SUPPOSED TO CHANGE. C ----------------------------------------- C IF ( NZ .NE. NZTRUE ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1000 ) NZTRUE, KINDX, NZ END IF END IF C IF ( .NOT. IVSAME ( N, INDX, INDXT ) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1100 ) NZTRUE, KINDX END IF END IF C C --------------------------- C ... TEST OUTPUT FROM SGTHRZ C --------------------------- C DO 400 I = 1, N C IF ( X(I) .NE. XTRUE(I) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1200 ) NZTRUE, KINDX, I, 1 X(I), XTRUE(I) END IF END IF C IF ( Y(I) .NE. YTRUE(I) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1300 ) NZTRUE, KINDX, I, 1 Y(I), YTRUE(I) END IF END IF C 400 CONTINUE C 500 CONTINUE C 600 CONTINUE C C ================================================================== C C ------------------ C ... END OF TESTING C ------------------ C ERRCNT = ERRCNT + COUNT IF ( COUNT .NE. 0 ) GO TO 800 C C ----------------------------------- C ... WRITE PASSED MESSAGE AND RETURN C ----------------------------------- C WRITE ( NOUT, 2700 ) GO TO 900 C C ----------------------------------- C ... WRITE FAILED MESSAGE AND RETURN C ----------------------------------- C 800 WRITE ( NOUT, 2800 ) COUNT C C ------------------------ C ... END OF MODULE TSGTHZ C ------------------------ C 900 CONTINUE RETURN C C ================================================================== C C ----------- C ... FORMATS C ----------- C 1000 FORMAT ( 5X, 'SGTHRZ ALTERED NZ FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5, 2 '. ALTERED VALUE OF NZ = ', I5 ) C 1100 FORMAT ( 5X, 'SGTHRZ ALTERED ARRAY INDX FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5 ) C 1200 FORMAT ( 5X, 'SGTHRZ OUTPUT ARRAY X IS INCORRECT FOR TEST WITH ', 1 'NZ = ', I5, ' AND THE INDX TYPE NO. ', I5 2 /5X, 'INACCURATE COMPONENT NO. ', I5, ' HAS VALUE =', 3 1PE15.5, ' TRUE VALUE =', 1PE15.5 ) C 1300 FORMAT ( 5X, 'SGTHRZ OUTPUT ARRAY Y IS INCORRECT FOR TEST WITH ', 1 'NZ = ', I5, ' AND THE INDX TYPE NO. ', I5 2 /5X, 'INACCURATE COMPONENT NO. ', I5, ' HAS VALUE =', 3 1PE15.5, ' TRUE VALUE =', 1PE15.5 ) C 2700 FORMAT ( /5X, 'SGTHRZ PASSED ALL TESTS.' ) C 2800 FORMAT ( /5X, 'SGTHRZ FAILED', I10, ' TESTS.' ) C C ================================================================== C END SUBROUTINE TSROTI ( NOUT, EPSILN, THRESH, NZMAX2, 1 NUMNZ, NZVALU, NUMG, CVALUE, SVALUE, 2 X, XSAVE, XTRUE, Y, YSAVE, 3 YTRUE , INDX, INDXT, LIST, ERRCNT, 4 ERRMAX ) C C ================================================================== C ================================================================== C ==== TSROTI -- CERTIFY SROTI ==== C ================================================================== C ================================================================== C C SUBROUTINE TSROTI IS THE CERTIFICATION MODULE FOR THE SPARSE C BASIC LINEAR ALGEBRA SUBROUTINE MODULE SROTI. C C WRITTEN BY ROGER G GRIMES C APRIL 1987 C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER NOUT, NZMAX2, NUMNZ, NUMG, ERRCNT, 1 ERRMAX C INTEGER NZVALU (*), INDX (*), INDXT (*), 1 LIST (*) C REAL EPSILN, THRESH C REAL CVALUE (*), SVALUE (*), 1 X (*), XSAVE (*), XTRUE (*), 2 Y (*), YSAVE (*), YTRUE (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER COUNT, I, ICLOBR, J, KG, 1 KINDX, KNZ, N, NZ, NZTRUE C REAL C, CLOBBR, CTRUE, ERR, S, 1 STRUE, V, W C C -------------------- C ... SUBPROGRAMS USED C -------------------- C LOGICAL IVSAME C EXTERNAL SCOPY, SINIT, ICOPY, IINIT, GNINDX, 1 IVSAME, SROTI C C ================================================================== C C ------------------ C ... INITIALIZATION C ------------------ C COUNT = 0 C CLOBBR = -1.0E10 ICLOBR = -10000000 C C ------------------------------------ C ... GENERATE SOME VALUES FOR X AND Y C ------------------------------------ C DO 100 I = 1, NZMAX2 XSAVE(I) = COS ( .6E0 * FLOAT(I) ) YSAVE(I) = SIN ( .7E0 * FLOAT(I) ) 100 CONTINUE C C ------------------------ C ... FOR EACH VALUE OF NZ C ------------------------ C DO 700 KNZ = 1, NUMNZ C NZTRUE = NZVALU(KNZ) N = 2 * MAX ( NZTRUE, 1 ) C C ----------------------------- C ... FOR EACH VALUE OF C AND S C ----------------------------- C DO 600 KG = 1, NUMG C CTRUE = CVALUE(KG) STRUE = SVALUE(KG) C C ------------------------------- C ... FOR EACH KIND OF INDX ARRAY C ------------------------------- C DO 500 KINDX = 1, 5 C CALL GNINDX ( NZTRUE, N, ICLOBR, KINDX, INDXT ) C CALL IINIT ( N, -1, LIST, 1 ) C DO 150 I = 1, NZTRUE LIST (INDXT(I)) = I 150 CONTINUE C C ----------------------- C ... GENERATE INPUT DATA C ----------------------- C I = MIN ( N, N-NZTRUE ) J = N - I + 1 CALL SCOPY ( NZTRUE, XSAVE, 1, XTRUE, 1 ) CALL SINIT ( I, CLOBBR, XTRUE(J), 1 ) CALL SINIT ( N, CLOBBR, YTRUE , 1 ) C DO 200 I = 1, NZTRUE YTRUE (INDXT(I)) = YSAVE (INDXT(I)) 200 CONTINUE C C ------------------- C ... COPY TRUE INPUT C ------------------- C C = CTRUE S = STRUE NZ = NZTRUE C CALL SCOPY ( N, YTRUE, 1, Y, 1 ) CALL SCOPY ( N, XTRUE, 1, X, 1 ) CALL ICOPY ( N, INDXT, 1, INDX, 1 ) C C -------------------------- C ... COMPUTE IN-LINE RESULT C -------------------------- C DO 300 I = 1, NZTRUE V = XTRUE(I) XTRUE(I) = CTRUE * V + 1 STRUE * YTRUE (INDXT(I)) YTRUE (INDXT(I)) = -STRUE * V + 1 CTRUE * YTRUE (INDXT(I)) 300 CONTINUE C C -------------- C ... CALL SROTI C -------------- C CALL SROTI ( NZ, X, INDX, Y, C, S ) C C ---------------------------------------- C ... TEST ARGUMENTS OF SROTI THAT ARE NOT C SUPPOSED TO CHANGE. C ---------------------------------------- C IF ( NZ .NE. NZTRUE ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1000 ) NZTRUE, CTRUE, STRUE, 1 KINDX, NZ END IF END IF C IF ( C .NE. CTRUE ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1100 ) NZTRUE, CTRUE, STRUE, 1 KINDX, C, S END IF END IF C IF ( S .NE. STRUE ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1200 ) NZTRUE, CTRUE, STRUE, 1 KINDX, C, S END IF END IF C IF ( .NOT. IVSAME ( N, INDX, INDXT ) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1300 ) NZTRUE, CTRUE, STRUE, 1 KINDX END IF END IF C C -------------------------- C ... TEST OUTPUT FROM SROTI C -------------------------- C DO 400 J = 1, N C IF ( LIST(J) .EQ. -1 ) THEN C IF ( X(J) .NE. XTRUE(J) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1400 ) NZTRUE, CTRUE, 1 STRUE, KINDX, J, 2 X(J), XTRUE(J) END IF END IF C IF ( Y(J) .NE. YTRUE(J) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1500 ) NZTRUE, CTRUE, 1 STRUE, KINDX, J, 2 Y(J), YTRUE(J) END IF END IF C ELSE C V = ABS ( X (LIST(J)) - XTRUE (LIST(J)) ) W = ABS ( CTRUE ) * ABS ( XSAVE (LIST(J)) ) + 1 ABS ( STRUE ) * ABS ( YSAVE(J) ) IF ( W .EQ. 0.0E0 ) W = 1.0E0 ERR = V / ( EPSILN * W ) IF ( ERR .GT. THRESH ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1600 ) NZTRUE, CTRUE, 1 STRUE, KINDX, I, 2 X (LIST(J)), 3 XTRUE (LIST(J)), 4 ERR END IF END IF C V = ABS ( Y(J) - YTRUE(J) ) W = ABS ( STRUE ) * ABS ( XSAVE (LIST(J)) ) + 1 ABS ( CTRUE ) * ABS ( YSAVE(J) ) IF ( W .EQ. 0.0E0 ) W = 1.0E0 ERR = V / ( EPSILN * W ) IF ( ERR .GT. THRESH ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1700 ) NZTRUE, CTRUE, 1 STRUE, KINDX, J, 2 Y(J), YTRUE(J), 3 ERR END IF END IF C END IF C 400 CONTINUE C 500 CONTINUE C 600 CONTINUE C 700 CONTINUE C C ================================================================== C C ------------------ C ... END OF TESTING C ------------------ C ERRCNT = ERRCNT + COUNT IF ( COUNT .NE. 0 ) GO TO 800 C C ----------------------------------- C ... WRITE PASSED MESSAGE AND RETURN C ----------------------------------- C WRITE ( NOUT, 2700 ) GO TO 900 C C ----------------------------------- C ... WRITE FAILED MESSAGE AND RETURN C ----------------------------------- C 800 WRITE ( NOUT, 2800 ) COUNT C C ------------------------ C ... END OF MODULE TSROTI C ------------------------ C 900 CONTINUE RETURN C C ================================================================== C C ----------- C ... FORMATS C ----------- C 1000 FORMAT ( 5X, 'SROTI ALTERED NZ FOR TEST WITH NZ = ', I5, 1 ' C, S = ', 1P, 2E15.5, ' AND THE INDX TYPE NO. ', I5 2 /5X, 'ALTERED VALUE OF NZ = ', I5 ) C 1100 FORMAT ( 5X, 'SROTI ALTERED C FOR TEST WITH NZ = ', I5, 1 ' C, S = ', 1P, 2E15.5, ' AND THE INDX TYPE NO. ', I5 2 /5X, 'ALTERED VALUE OF C = ', 1PE15.5 ) C 1200 FORMAT ( 5X, 'SROTI ALTERED S FOR TEST WITH NZ = ', I5, 1 ' C, S = ', 1P, 2E15.5, ' AND THE INDX TYPE NO. ', I5 2 /5X, 'ALTERED VALUE OF S = ', 1PE15.5 ) C 1300 FORMAT ( 5X, 'SROTI ALTERED ARRAY INDX FOR TEST WITH NZ = ', I5, 1 ' C, S = ', 1P, 2E15.5, ' AND THE INDX TYPE NO. ', 2 I5 ) C 1400 FORMAT ( 5X, 'SROTI OUTPUT ARRAY X IS INCORRECT FOR TEST WITH ', 1 'NZ = ', I5, ' C, S = ', 1P, 2E15.5, 2 ' AND THE INDX TYPE NO. ', I5 3 /5X, 'INCORRECT COMPONENT NO. ', I5, ' HAS VALUE = ', 4 1PE15.5, ' TRUE VALUE = ', 1PE15.5 ) C 1500 FORMAT ( 5X, 'SROTI OUTPUT ARRAY Y IS INCORRECT FOR TEST WITH ', 1 'NZ = ', I5, ' C, S = ', 1P, 2E15.5, 2 ' AND THE INDX TYPE NO. ', I5 3 /5X, 'INCORRECT COMPONENT NO. ', I5, ' HAS VALUE = ', 4 1PE15.5, ' TRUE VALUE = ', 1PE15.5 ) C 1600 FORMAT ( 5X, 'SROTI OUTPUT ARRAY X IS INACCURATE FOR TEST WITH ', 1 'NZ = ', I5, ' C, S = ', 1P, 2E15.5, 2 ' AND THE INDX TYPE NO. ', I5 3 /5X, 'INACCURATE COMPONENT NO. ', I5, ' HAS VALUE = ', 4 1PE15.5, ' TRUE VALUE = ', 1PE15.5, ' ERROR = ', 5 1PE12.1 ) C 1700 FORMAT ( 5X, 'SROTI OUTPUT ARRAY Y IS INACCURATE FOR TEST WITH ', 1 'NZ = ', I5, ' C, S = ', 1P, 2E15.5, 2 ' AND THE INDX TYPE NO. ', I5 3 /5X, 'INACCURATE COMPONENT NO. ', I5, ' HAS VALUE = ', 4 1PE15.5, ' TRUE VALUE = ', 1PE15.5, ' ERROR = ', 5 1PE12.1 ) C 2700 FORMAT ( /5X, 'SROTI PASSED ALL TESTS.' ) C 2800 FORMAT ( /5X, 'SROTI FAILED', I10, ' TESTS.' ) C C ================================================================== C END SUBROUTINE TSSCTR ( NOUT, NZMAX2, NUMNZ, NZVALU, 1 X, XSAVE, XTRUE, Y, YSAVE, 2 YTRUE , INDX, INDXT, ERRCNT, ERRMAX ) C C ================================================================== C ================================================================== C ==== TSSCTR -- CERTIFY SSCTR ==== C ================================================================== C ================================================================== C C SUBROUTINE TSSCTR IS THE CERTIFICATION MODULE FOR THE SPARSE C BASIC LINEAR ALGEBRA SUBROUTINE MODULE SSCTR. C C WRITTEN BY ROGER G GRIMES C APRIL 1987 C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER NOUT, NZMAX2, NUMNZ, ERRCNT, 1 ERRMAX C INTEGER NZVALU (*), INDX (*), INDXT (*) C REAL X (*), XSAVE (*), XTRUE (*), 1 Y (*), YSAVE (*), YTRUE (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER COUNT, I, ICLOBR, J, KINDX, 1 KNZ, N, NZ, NZTRUE C REAL CLOBBR C C -------------------- C ... SUBPROGRAMS USED C -------------------- C LOGICAL IVSAME, SVSAME C EXTERNAL ICOPY, SCOPY, SINIT, GNINDX, 1 IVSAME, SVSAME, SSCTR C C ================================================================== C C ------------------ C ... INITIALIZATION C ------------------ C COUNT = 0 C CLOBBR = -1.0E10 ICLOBR = -10000000 C C ------------------------------------ C ... GENERATE SOME VALUES FOR X AND Y C ------------------------------------ C DO 100 I = 1, NZMAX2 XSAVE(I) = COS ( .6*FLOAT(I) ) YSAVE(I) = SIN ( .7*FLOAT(I) ) 100 CONTINUE C C ------------------------ C ... FOR EACH VALUE OF NZ C ------------------------ C DO 600 KNZ = 1, NUMNZ C NZTRUE = NZVALU(KNZ) N = 2 * MAX ( NZTRUE, 1 ) C C ------------------------------- C ... FOR EACH KIND OF INDX ARRAY C ------------------------------- C DO 500 KINDX = 1, 5 C CALL GNINDX ( NZTRUE, N, ICLOBR, KINDX, INDXT ) C C ----------------------- C ... GENERATE INPUT DATA C ----------------------- C I = MIN ( N, N-NZTRUE ) J = N - I + 1 CALL SCOPY ( NZTRUE, XSAVE, 1, XTRUE, 1 ) CALL SINIT ( I, CLOBBR, XTRUE(J), 1 ) CALL SINIT ( N, CLOBBR, YTRUE, 1 ) C C ------------------- C ... COPY TRUE INPUT C ------------------- C NZ = NZTRUE C CALL SCOPY ( N, YTRUE, 1, Y, 1 ) CALL SCOPY ( N, XTRUE, 1, X, 1 ) CALL ICOPY ( N, INDXT, 1, INDX, 1 ) C C -------------------------- C ... COMPUTE IN-LINE RESULT C -------------------------- C DO 300 I = 1, NZTRUE YTRUE (INDXT(I)) = XTRUE (I) 300 CONTINUE C C -------------- C ... CALL SSCTR C -------------- C CALL SSCTR ( NZ, X, INDX, Y ) C C ---------------------------------------- C ... TEST ARGUMENTS OF SSCTR THAT ARE NOT C SUPPOSED TO CHANGE. C ---------------------------------------- C IF ( NZ .NE. NZTRUE ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1000 ) NZTRUE, KINDX, NZ END IF END IF C IF ( .NOT. SVSAME ( N, X, XTRUE ) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1100 ) NZTRUE, KINDX END IF END IF C IF ( .NOT. IVSAME ( N, INDX, INDXT ) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1200 ) NZTRUE, KINDX END IF END IF C C -------------------------- C ... TEST OUTPUT FROM SSCTR C -------------------------- C DO 400 I = 1, N IF ( Y(I) .NE. YTRUE(I) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1300 ) NZTRUE, KINDX, I, 1 Y(I), YTRUE(I) END IF END IF 400 CONTINUE C 500 CONTINUE C 600 CONTINUE C C ================================================================== C C ------------------ C ... END OF TESTING C ------------------ C ERRCNT = ERRCNT + COUNT IF ( COUNT .NE. 0 ) GO TO 800 C C ----------------------------------- C ... WRITE PASSED MESSAGE AND RETURN C ----------------------------------- C WRITE ( NOUT, 2700 ) GO TO 900 C C ----------------------------------- C ... WRITE FAILED MESSAGE AND RETURN C ----------------------------------- C 800 WRITE ( NOUT, 2800 ) COUNT C C ------------------------ C ... END OF MODULE TSSCTR C ------------------------ C 900 CONTINUE RETURN C C ================================================================== C C ----------- C ... FORMATS C ----------- C 1000 FORMAT ( 5X, 'SSCTR ALTERED NZ FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5, 2 '. ALTERED VALUE OF NZ = ', I5 ) C 1100 FORMAT ( 5X, 'SSCTR ALTERED ARRAY X FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5 ) C 1200 FORMAT ( 5X, 'SSCTR ALTERED ARRAY INDX FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5 ) C 1300 FORMAT ( 5X, 'SSCTR OUTPUT ARRAY Y IS INCORRECT FOR TEST WITH ', 1 'NZ = ', I5, ' AND THE INDX TYPE NO. ', I5 2 /5X, 'INACCURATE COMPONENT NO. ', I5, ' HAS VALUE =', 3 1PE15.5, ' TRUE VALUE =', 1PE15.5 ) C 2700 FORMAT ( /5X, 'SSCTR PASSED ALL TESTS.' ) C 2800 FORMAT ( /5X, 'SSCTR FAILED', I10, ' TESTS.' ) C C ================================================================== C END REAL FUNCTION SDIFF ( X, Y ) C C ================================================================== C C SDIFF IS USED BY THE MAIN PROGRAM TO COMPARE 1.0 + EPSILN WITH C 1.0. ITS SOLE USE IS TO FOOL AN OPTIMIZING COMPILER. C C ================================================================== C C ------------------------ C ... VARIABLE DECLARATION C ------------------------ C REAL X, Y C C ================================================================== C SDIFF = X - Y C C ================================================================== C RETURN END LOGICAL FUNCTION SVSAME ( N, SX, SY ) C C ================================================================== C C LOGICAL FUNCTION SVSAME DETERMINES IF THE VECTORS SX AND SY C AGREE EXACTLY WITH EACH OTHER. C C ================================================================== C C ------------------------ C ... VARIABLE DECLARATION C ------------------------ C INTEGER I, N C REAL SX (*), SY (*) C C ================================================================== C SVSAME = .TRUE. C DO 10 I = 1, N IF ( SX(I) .NE. SY(I) ) THEN SVSAME = .FALSE. GO TO 20 ENDIF 10 CONTINUE C 20 RETURN END SUBROUTINE ICOPY ( N, X, INCX, Y, INCY ) C C ================================================================== C ================================================================== C ==== ICOPY -- COPY ONE INTEGER VECTOR TO ANOTHER ==== C ================================================================== C ================================================================== C C PURPOSE ... (VARIANT OF 'SCOPY') C COPY ONE INTEGER VECTOR TO ANOTHER. C STANDARD INCREMENT OF 1 SHOULD BE USED FOR FORWARD C COPY WITHIN SAME VECTOR. C C CREATED ... MAR. 12, 1985 C LAST MODIFIED ... APR. 19, 1985 C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER N, INCX, INCY C INTEGER X (*), Y (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER XADDR, YADDR, I C C ================================================================== C IF ( INCX .EQ. 1 .AND. INCY .EQ. 1 ) THEN C C ----------------------------------- C ... UNIT INCREMENTS (STANDARD CASE) C ----------------------------------- C DO 100 I = 1, N Y (I) = X (I) 100 CONTINUE C ELSE C C ------------------------- C ... NON-UNIT INCREMENTS C (-1) USED FOR REVERSE C COPYING IN SAME ARRAY C ------------------------- C XADDR = 1 YADDR = 1 C IF ( INCX .LT. 0 ) THEN XADDR = (-N+1)*INCX + 1 ENDIF C IF ( INCY .LT. 0 ) THEN YADDR = (-N+1)*INCY + 1 ENDIF C DO 200 I = 1, N Y (YADDR) = X (XADDR) XADDR = XADDR + INCX YADDR = YADDR + INCY 200 CONTINUE C ENDIF C RETURN C END SUBROUTINE IINIT ( N, A, X, INCX ) C C ================================================================== C ================================================================== C ==== IINIT -- INITIALIZE INTEGER VECTOR TO CONSTANT ==== C ================================================================== C ================================================================== C C PURPOSE ... INITIALIZES INTEGER VECTOR TO A CONSTANT VALUE 'A' C C CREATED ... MAR. 8, 1985 C LAST MODIFIED ... APR. 19, 1985 C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER N, INCX C INTEGER A, X (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER XADDR, I C C ================================================================== C IF ( INCX .EQ. 1 ) THEN C C ---------------------------------- C ... UNIT INCREMENT (STANDARD CASE) C ---------------------------------- C DO 100 I = 1, N X(I) = A 100 CONTINUE C ELSE C C ---------------------- C ... NON-UNIT INCREMENT C ---------------------- C XADDR = 1 IF ( INCX .LT. 0 ) THEN XADDR = (-N+1)*INCX + 1 ENDIF C DO 200 I = 1, N X (XADDR) = A XADDR = XADDR + INCX 200 CONTINUE C ENDIF C RETURN C END SUBROUTINE GNINDX ( NZ, N, ICLOBR, KINDX, INDX ) C C ================================================================== C ================================================================== C ==== GNINDX -- GENERATE INDEX ARRAY PATTERNS ==== C ================================================================== C ================================================================== C C GNINDX GENERATES VARIOUS PATTERNS FOR THE ARRAY INDX BASED C ON THE KEY KINDX. THE GENERATED INDX ARRAY HAS NZ SIGNIFICANT C COMPONENTS. THE REMAINING N-NZ COMPONENTS ARE SET TO C ICLOBR. C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER NZ, N, ICLOBR, KINDX, INDX (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER I, L C C -------------------- C ... SUBPROGRAMS USED C -------------------- C EXTERNAL IINIT C C ================================================================== C IF ( N .LE. 0 ) RETURN C L = MAX ( N, N-NZ ) CALL IINIT ( L, ICLOBR, INDX, 1 ) C IF ( NZ .LE. 0 ) RETURN C KINDX = MAX ( KINDX, 1 ) KINDX = MIN ( KINDX, 5 ) C C ------------------- C ... BRANCH ON KINDX C ------------------- C GO TO ( 100, 200, 300, 400, 500 ), KINDX C C ----------------------------------- C ... ASCENDING ORDER - 1, 2, ..., NZ C ----------------------------------- C 100 DO 110 I = 1, NZ INDX(I) = I 110 CONTINUE GO TO 900 C C ------------------------------------------ C ... ASCENDING ORDER - N-NZ+1, N-NZ, ..., N C ------------------------------------------ C 200 L = N - NZ DO 210 I = 1, NZ INDX(I) = L + I 210 CONTINUE GO TO 900 C C --------------------------------------- C ... DESCENDING ORDER - NZ, NZ-1, ..., 1 C --------------------------------------- C 300 L = NZ DO 310 I = 1, NZ INDX(I) = L L = L -1 310 CONTINUE GO TO 900 C C ------------------------------------------ C ... DESCENDING ORDER - N, N-1, ..., N-NZ+1 C ------------------------------------------ C 400 L = N DO 410 I = 1, NZ INDX(I) = L L = L - 1 410 CONTINUE GO TO 900 C C -------------------------------------------------------- C ... ALTERNATING ORDER WITH EVEN NUMBERS IN REVERSE ORDER C -------------------------------------------------------- C 500 DO 510 I = 1, NZ, 2 INDX(I) = I 510 CONTINUE C L = N DO 520 I = 2, NZ, 2 INDX(I) = L L = L - 2 520 CONTINUE GO TO 900 C C ================================================================== C 900 RETURN END LOGICAL FUNCTION IVSAME ( N, IX, IY ) C C ================================================================== C C LOGICAL FUNCTION IVSAME DETERMINES IF THE VECTORS IX AND IY C AGREE EXACTLY WITH EACH OTHER. C C ================================================================== C C ------------------------ C ... VARIABLE DECLARATION C ------------------------ C INTEGER I, N, IX (*), IY (*) C C ================================================================== C IVSAME = .TRUE. C IF ( N .LE. 0 ) RETURN C DO 10 I = 1, N IF ( IX(I) .NE. IY(I) ) THEN IVSAME = .FALSE. GO TO 20 ENDIF 10 CONTINUE C 20 RETURN C END SUBROUTINE SCOPY ( N, X, INCX, Y, INCY ) C C ================================================================== C ================================================================== C ==== SCOPY -- COPY ONE REAL VECTOR TO ANOTHER ==== C ================================================================== C ================================================================== C C PURPOSE ... STANDARD BLAS C COPY ONE REAL VECTOR TO ANOTHER. C STANDARD INCREMENT OF 1 SHOULD BE USED FOR FORWARD C COPY WITHIN SAME VECTOR. C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER N, INCX, INCY C REAL X (*), Y (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER XADDR, YADDR, I C C ================================================================== C IF ( INCX .EQ. 1 .AND. INCY .EQ. 1 ) THEN C C ----------------------------------- C ... UNIT INCREMENTS (STANDARD CASE) C ----------------------------------- C DO 100 I = 1, N Y (I) = X (I) 100 CONTINUE C ELSE C C ------------------------- C ... NON-UNIT INCREMENTS C (-1) USED FOR REVERSE C COPYING IN SAME ARRAY C ------------------------- C XADDR = 1 YADDR = 1 C IF ( INCX .LT. 0 ) THEN XADDR = (-N+1)*INCX + 1 ENDIF C IF ( INCY .LT. 0 ) THEN YADDR = (-N+1)*INCY + 1 ENDIF C DO 200 I = 1, N Y (YADDR) = X (XADDR) XADDR = XADDR + INCX YADDR = YADDR + INCY 200 CONTINUE C ENDIF C RETURN C END SUBROUTINE SINIT ( N, A, X, INCX ) C C ================================================================== C ================================================================== C ==== SINIT -- INITIALIZE REAL VECTOR TO CONSTANT ==== C ================================================================== C ================================================================== C C PURPOSE ... INITIALIZES REAL VECTOR TO A CONSTANT VALUE 'A' C C CREATED ... APR. 14, 1987 C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER N, INCX C REAL A, X (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER XADDR, I C C ================================================================== C IF ( INCX .EQ. 1 ) THEN C C ---------------------------------- C ... UNIT INCREMENT (STANDARD CASE) C ---------------------------------- C DO 100 I = 1, N X(I) = A 100 CONTINUE C ELSE C C ---------------------- C ... NON-UNIT INCREMENT C ---------------------- C XADDR = 1 IF ( INCX .LT. 0 ) THEN XADDR = (-N+1)*INCX + 1 ENDIF C DO 200 I = 1, N X (XADDR) = A XADDR = XADDR + INCX 200 CONTINUE C ENDIF C RETURN C END SUBROUTINE SAXPYI ( NZ, A, X, INDX, Y ) C C ================================================================== C ================================================================== C ==== SAXPYI -- INDEXED REAL ELEMENTARY VECTOR OPERATION ==== C ================================================================== C ================================================================== C C PURPOSE C ------- C C SAXPYI ADDS A REAL SCALAR MULTIPLE OF C A REAL SPARSE VECTOR X C STORED IN COMPRESSED FORM (X,INDX) C TO C A REAL VECTOR Y IN FULL STORAGE FORM. C C ONLY THE ELEMENTS OF Y WHOSE INDICES ARE LISTED IN INDX C ARE REFERENCED OR MODIFIED. THE VALUES IN INDX MUST BE C DISTINCT TO ALLOW CONSISTENT VECTOR OR PARALLEL EXECUTION. C C ALTHOUGH DISTINCT INDICES WILL ALLOW VECTOR OR PARALLEL C EXECUTION, MOST COMPILERS FOR HIGH-PERFORMANCE MACHINES WILL C BE UNABLE TO GENERATE BEST POSSIBLE CODE WITHOUT SOME C MODIFICATION, SUCH AS COMPILER DIRECTIVES, TO THIS CODE. C C ARGUMENTS C --------- C C INPUT ... C C NZ INTEGER NUMBER OF ELEMENTS IN THE COMPRESSED FORM. C A REAL SCALAR MULTIPLIER OF X. C X REAL ARRAY CONTAINING THE VALUES OF THE C COMPRESSED FORM. C INDX INTEGER ARRAY CONTAINING THE INDICES OF THE C COMPRESSED FORM. IT IS ASSUMED THAT C THE ELEMENTS IN INDX ARE DISTINCT. C C UPDATED ... C C Y REAL ARRAY, ON INPUT, WHICH CONTAINS THE VECTOR C Y IN FULL STORAGE FORM. ON OUTPUT C ONLY THE ELEMENTS CORRESPONDING TO THE C INDICES IN INDX HAVE BEEN MODIFIED. C C C SPARSE BASIC LINEAR ALGEBRA SUBPROGRAM C C FORTRAN VERSION WRITTEN OCTOBER 1984 C ROGER G GRIMES, BOEING COMPUTER SERVICES C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER NZ, INDX (*) C REAL Y (*), X (*), A C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER I C C ================================================================== C IF ( NZ .LE. 0 ) RETURN C IF ( A .EQ. 0.0E0 ) RETURN C DO 10 I = 1, NZ Y(INDX(I)) = Y(INDX(I)) + A * X(I) 10 CONTINUE C RETURN END REAL FUNCTION SDOTI ( NZ, X, INDX, Y ) C C ================================================================== C ================================================================== C ==== SDOTI -- REAL INDEXED DOT PRODUCT ==== C ================================================================== C ================================================================== C C PURPOSE C ------- C C SDOTI COMPUTES THE VECTOR INNER PRODUCT OF C A REAL SPARSE VECTOR X C STORED IN COMPRESSED FORM (X,INDX) C WITH C A REAL VECTOR Y IN FULL STORAGE FORM. C C ONLY THE ELEMENTS OF Y WHOSE INDICES ARE LISTED IN INDX C ARE REFERENCED. C C ARGUMENTS C --------- C C INPUT ... C C NZ INTEGER NUMBER OF ELEMENTS IN THE COMPRESSED FORM. C X REAL ARRAY CONTAINING THE VALUES OF THE C COMPRESSED FORM. C INDX INTEGER ARRAY CONTAINING THE INDICES OF THE C COMPRESSED FORM. C Y REAL ARRAY, ON INPUT, WHICH CONTAINS THE C VECTOR Y IN FULL STORAGE FORM. ONLY C THE ELEMENTS CORRESPONDING TO THE C INDICES IN INDX WILL BE ACCESSED. C C OUTPUT ... C C SDOTI REAL REAL FUNCTION VALUE EQUAL TO THE C VECTOR INNER PRODUCT. C IF NZ .LE. 0 SDOTI IS SET TO ZERO. C C SPARSE BASIC LINEAR ALGEBRA SUBPROGRAM C C FORTRAN VERSION WRITTEN OCTOBER 1984 C ROGER G GRIMES, BOEING COMPUTER SERVICES C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER NZ, INDX (*) C REAL X (*), Y (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER I C C ================================================================== C SDOTI = 0.0E0 IF ( NZ .LE. 0 ) RETURN C DO 10 I = 1, NZ SDOTI = SDOTI + X(I) * Y(INDX(I)) 10 CONTINUE C RETURN END SUBROUTINE SGTHR ( NZ, Y, X, INDX ) C C ================================================================== C ================================================================== C ==== SGTHR -- REAL GATHER ==== C ================================================================== C ================================================================== C C PURPOSE C ------- C C SGTHR GATHERS THE SPECIFIED ELEMENTS FROM C A REAL VECTOR Y IN FULL STORAGE FORM C INTO C A REAL VECTOR X IN COMPRESSED FORM (X,INDX). C C ONLY THE ELEMENTS OF Y WHOSE INDICES ARE LISTED IN INDX C ARE REFERENCED. C C ARGUMENTS C --------- C C INPUT ... C C NZ INTEGER NUMBER OF ELEMENTS TO BE GATHERED INTO C COMPRESSED FORM. C Y REAL ARRAY, ON INPUT, WHICH CONTAINS THE C VECTOR Y IN FULL STORAGE FORM. ONLY C THE ELEMENTS CORRESPONDING TO THE INDICES C IN INDX WILL BE ACCESSED. C INDX INTEGER ARRAY CONTAINING THE INDICES OF THE VALUES C TO BE GATHERED INTO COMPRESSED FORM. C C OUTPUT ... C C X REAL ARRAY CONTAINING THE VALUES GATHERED INTO C THE COMPRESSED FORM. C C SPARSE BASIC LINEAR ALGEBRA SUBPROGRAM C C FORTRAN VERSION WRITTEN OCTOBER 1984 C ROGER G GRIMES, BOEING COMPUTER SERVICES C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C C INTEGER NZ, INDX (*) C REAL Y (*), X (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER I C C ================================================================== C IF ( NZ .LE. 0 ) RETURN C DO 10 I = 1, NZ X(I) = Y(INDX(I)) 10 CONTINUE C RETURN END SUBROUTINE SGTHRZ ( NZ, Y, X, INDX ) C C ================================================================== C ================================================================== C ==== SGTHRZ -- REAL GATHER AND ZERO ==== C ================================================================== C ================================================================== C C PURPOSE C ------- C C SGTHRZ GATHERS THE SPECIFIED ELEMENTS FROM C A REAL VECTOR Y IN FULL STORAGE FORM C INTO C A REAL VECTOR X IN COMPRESSED FORM (X,INDX). C FURTHERMORE THE GATHERED ELEMENTS OF Y ARE SET TO ZERO. C C ONLY THE ELEMENTS OF Y WHOSE INDICES ARE LISTED IN INDX C ARE REFERENCED OR MODIFIED. C C ARGUMENTS C --------- C C INPUT ... C C NZ INTEGER NUMBER OF ELEMENTS TO BE GATHERED INTO C COMPRESSED FORM. C INDX INTEGER ARRAY CONTAINING THE INDICES OF THE VALUES C TO BE GATHERED INTO COMPRESSED FORM. C C UPDATED ... C C Y REAL ARRAY, ON INPUT, WHICH CONTAINS THE VECTOR C Y IN FULL STORAGE FORM. THE GATHERED C COMPONENTS IN Y ARE SET TO ZERO. C ONLY THE ELEMENTS CORRESPONDING TO THE C INDICES IN INDX HAVE BEEN ACCESSED. C C OUTPUT ... C C X REAL ARRAY CONTAINING THE VALUES GATHERED INTO C THE COMPRESSED FORM. C C SPARSE BASIC LINEAR ALGEBRA SUBPROGRAM C C FORTRAN VERSION WRITTEN OCTOBER 1984 C ROGER G GRIMES, BOEING COMPUTER SERVICES C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER NZ, INDX (*) C REAL Y (*), X (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER I C C ================================================================== C IF ( NZ .LE. 0 ) RETURN C DO 10 I = 1, NZ X(I) = Y(INDX(I)) Y(INDX(I)) = 0.0E0 10 CONTINUE C RETURN END SUBROUTINE SROTI ( NZ, X, INDX, Y, C, S ) C C ================================================================== C ================================================================== C ==== SROTI -- APPLY INDEXED REAL GIVENS ROTATION ==== C ================================================================== C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C C PURPOSE C ------- C C SROTI APPLIES A GIVENS ROTATION TO C A SPARSE VECTOR X STORED IN COMPRESSED FORM (X,INDX) C AND C ANOTHER VECTOR Y IN FULL STORAGE FORM. C C SROTI DOES NOT HANDLE FILL-IN IN X AND THEREFORE, IT IS C ASSUMED THAT ALL NONZERO COMPONENTS OF Y ARE LISTED IN C INDX. ONLY THE ELEMENTS OF Y WHOSE INDICES ARE LISTED IN C INDX ARE REFERENCED OR MODIFIED. THE VALUES IN INDX MUST C BE DISTINCT TO ALLOW CONSISTENT VECTOR OR PARALLEL EXECUTION. C C ALTHOUGH DISTINCT INDICES WILL ALLOW VECTOR OR PARALLEL C EXECUTION, MOST COMPILERS FOR HIGH-PERFORMANCE MACHINES WILL C BE UNABLE TO GENERATE BEST POSSIBLE CODE WITHOUT SOME C MODIFICATION, SUCH AS COMPILER DIRECTIVES, TO THIS CODE. C C ARGUMENTS C --------- C C INPUT ... C C NZ INTEGER NUMBER OF ELEMENTS IN THE COMPRESSED FORM. C INDX INTEGER ARRAY CONTAINING THE INDICES OF THE C COMPRESSED FORM. IT IS ASSUMED THAT C THE ELEMENTS IN INDX ARE DISTINCT. C C,S REAL THE TWO SCALARS DEFINING THE GIVENS C ROTATION. C C UPDATED ... C C X REAL ARRAY CONTAINING THE VALUES OF THE C SPARSE VECTOR IN COMPRESSED FORM. C Y REAL ARRAY WHICH CONTAINS THE VECTOR Y C IN FULL STORAGE FORM. ONLY THE C ELEMENTS WHOSE INDICES ARE LISTED IN C INDX HAVE BEEN REFERENCED OR MODIFIED. C C C SPARSE BASIC LINEAR ALGEBRA SUBPROGRAM C C FORTRAN VERSION WRITTEN OCTOBER 1984 C ROGER G GRIMES, BOEING COMPUTER SERVICES C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER NZ, INDX (*) C REAL X (*), Y (*), C, S C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER I C REAL TEMP C C ================================================================== C IF ( NZ .LE. 0 ) RETURN C IF ( ( C .EQ. 1.0E0 ) .AND. ( S .EQ. 0.0E0 ) ) RETURN C DO 10 I = 1, NZ TEMP = - S * X (I) + C * Y (INDX(I)) X (I) = C * X (I) + S * Y (INDX(I)) Y (INDX(I)) = TEMP 10 CONTINUE C RETURN END SUBROUTINE SSCTR ( NZ, X, INDX, Y ) C C ================================================================== C ================================================================== C ==== SSCTR -- REAL SCATTER ==== C ================================================================== C ================================================================== C C PURPOSE C ------- C C SSCTR SCATTERS THE COMPONENTS OF C A SPARSE VECTOR X STORED IN COMPRESSED FORM (X,INDX) C INTO C SPECIFIED COMPONENTS OF A REAL VECTOR Y C IN FULL STORAGE FORM. C C ONLY THE ELEMENTS OF Y WHOSE INDICES ARE LISTED IN INDX C ARE MODIFIED. THE VALUES IN INDX MUST BE DISTINCT TO C ALLOW CONSISTENT VECTOR OR PARALLEL EXECUTION. C C ALTHOUGH DISTINCT INDICES WILL ALLOW VECTOR OR PARALLEL C EXECUTION, MOST COMPILERS FOR HIGH-PERFORMANCE MACHINES WILL C BE UNABLE TO GENERATE BEST POSSIBLE CODE WITHOUT SOME C MODIFICATION, SUCH AS COMPILER DIRECTIVES, TO THIS CODE. C C ARGUMENTS C --------- C C INPUT ... C C NZ INTEGER NUMBER OF ELEMENTS TO BE SCATTERED FROM C COMPRESSED FORM. C X REAL ARRAY CONTAINING THE VALUES TO BE C SCATTERED FROM COMPRESSED FORM INTO FULL C STORAGE FORM. C INDX INTEGER ARRAY CONTAINING THE INDICES OF THE C VALUES TO BE SCATTERED FROM COMPRESSED C FORM. IT IS ASSUMED THAT THE ELEMENTS C IN INDX ARE DISTINCT. C C OUTPUT ... C C Y REAL ARRAY WHOSE ELEMENTS SPECIFIED BY INDX C HAVE BEEN SET TO THE CORRESPONDING C ENTRIES OF X. ONLY THE ELEMENTS C CORRESPONDING TO THE INDICES IN INDX C HAVE BEEN MODIFIED. C C SPARSE BASIC LINEAR ALGEBRA SUBPROGRAM C C FORTRAN VERSION WRITTEN OCTOBER 1984 C ROGER G GRIMES, BOEING COMPUTER SERVICES C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER NZ, INDX (*) C REAL X (*), Y (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER I C C ================================================================== C IF ( NZ .LE. 0 ) RETURN C DO 10 I = 1, NZ Y(INDX(I)) = X(I) 10 CONTINUE C RETURN END 'SBLATS.SUMM' 6 100 5.0 16 -1 0 1 2 5 9 31 32 33 63 64 65 127 128 129 257 3 0.0 1.0 0.7 4 1. 0. -.6 .8 0. 1. .8 -.6 PROGRAM TCSPBL C C ================================================================== C ================================================================== C ==== TCSPBL -- CERTIFY COMPLEX SPARSE BLAS ==== C ================================================================== C ================================================================== C C TCSPBL IS THE CERTIFICATION PROGRAM FOR THE COMPLEX SPARSE BLAS. C THE APPROACH USED TO CERTIFY THE SPARSE BLAS IS AS FOLLOWS: C C 1. READ IN USER SPECIFIED INPUT ON OUTPUT UNIT, THRESHOLD VALUE C FOR TEST RATIO, AND THE SPECIFICATIONS FOR NZ, AND A. C 2. VERIFY THE CORRECTNESS OF THE USER SPECIFIED INPUT AND C ECHO TO THE OUTPUT UNIT. C 3. FOR EACH SUBPROGRAM IN THE COMPLEX SPARSE BLAS C PERFORM ALL THE USER SPECIFIED TESTS AND PRINT A PASS/FAIL C MESSAGE. TESTS WHICH FAIL GENERATE ADDITIONAL OUTPUT. C C SPARSE BLAS SUBPROGRAMS WHICH ARE CERTIFIED BY THIS PROGRAM ARE C C CAXPYI CDOTUI CGTHRZ C CDOTCI CGTHR CSCTR C C THIS PROGRAM REQUIRES AN INPUT FILE ASSIGNED TO UNIT NIN C (CURRENTLY SET TO 5 BY A PARAMETER STATEMENT). THE DATA ON C THIS INPUT FILE CONTROLS THE OUTPUT UNIT, THE THRESHOLD VALUE C FOR THE NUMERICAL TESTING, AND THE SPECIFICATIONS FOR THE C TEST VALUES FOR THE LENGTH OF THE SPARSE VECTORS AND THE SCALARS C USED BY THE VARIOUS SUBPROGRAMS. AN EXAMPLE OF THE INPUT FILE C FOLLOWS C C LINE 1 'CBLATS.SUMM' NAME OF OUTPUT FILE C LINE 2 6 UNIT NUMBER OF OUTPUT FILE C LINE 3 100 MAX. NO. OF PRINTED ERROR MESSAGES C LINE 4 5.0 THRESHOLD VALUE OF TEST RATIO C LINE 5 16 NUMBER OF VALUES OF NZ C LINE 6 -1 0 1 2 5 9 31 32 33 63 64 65 127 128 129 257 C VALUES OF NZ C LINE 7 3 NUMBER OF VALUES OF A FOR -AXPYI C LINE 8 (0.0,0.0) (1.0,0.0) (0.7,0.3) C VALUES OF A C C C THIS INPUT FILE IS READ USING FORTRAN-77 STANDARD LIST DIRECTED C INPUT. SINGLE QUOTES ARE REQUIRED AROUND THE NAME OF THE OUTPUT C FILE ON LINE 1. THE NUMBERS ON LINES 6 AND 8 CAN BE C DELIMITED BY BLANKS OR COMMAS. C C THIS PROGRAM WAS WRITTEN BY ROGER G. GRIMES, BOEING C COMPUTER SERVICES, BELLEVUE, WA. DURING APRIL, 1987. C C ================================================================== C C ------------------------------------ C ... PROBLEM SPECIFICATION PARAMETERS C ------------------------------------ C C NIN INPUT UNIT C NZMAX MAXIMUM VALUE OF ANY SINGLE NZ C NNZMAX MAXIMUM NUMBER OF VALUES OF NZ C NAMAX MAXIMUM NUMBER OF VALUES OF A (-AXPYI C SCALAR) C INTEGER NIN, NZMAX, NNZMAX, NAMAX C PARAMETER ( NIN = 5, NZMAX = 320, 1 NNZMAX = 24, NAMAX = 7 ) C C ================================================================== C C ----------------------- C ... COMPUTED PARAMETERS C ----------------------- C INTEGER NZMAX2 C PARAMETER ( NZMAX2 = 2 * NZMAX ) C C ================================================================== C C ------------------------ C ... VARIABLE DECLARATION C ------------------------ C CHARACTER*32 NAMOUT C INTEGER ERRCNT, ERRMAX, I, NOUT, NUMA, 1 NUMNZ C INTEGER INDX (NZMAX2), INDXT (NZMAX2), 1 LIST (NZMAX2), NZVALU(NNZMAX) C REAL EPSILN, EPSSAV, THRESH C COMPLEX X (NZMAX2), Y (NZMAX2), 1 XTRUE (NZMAX2), YTRUE (NZMAX2), 2 XSAVE (NZMAX2), YSAVE (NZMAX2), 3 AVALUE(NAMAX) C C -------------------- C ... SUBPROGRAMS USED C -------------------- C REAL SDIFF C EXTERNAL TCXPYI, TCDTCI, TCDTUI, TCGTHR, TCGTHZ, 1 TCSCTR, SDIFF C C ================================================================== C ERRCNT = 0 C C ------------------------------------------------ C ... READ IN USER SPECIFIED INPUT FOR OUTPUT UNIT C ------------------------------------------------ C READ ( NIN, * ) NAMOUT READ ( NIN, * ) NOUT C C -------------------- C ... OPEN OUTPUT UNIT C -------------------- C OPEN ( UNIT = NOUT, FILE = NAMOUT, STATUS = 'NEW' ) C C ------------------------------ C ... READ IN REMAINDER OF INPUT C ------------------------------ C READ ( NIN, * ) ERRMAX READ ( NIN, * ) THRESH READ ( NIN, * ) NUMNZ C IF ( NUMNZ .GT. NNZMAX ) THEN ERRCNT = 1 WRITE ( NOUT, 1100 ) NUMNZ, NNZMAX GO TO 900 END IF C READ ( NIN, * ) ( NZVALU(I), I = 1, NUMNZ ) C READ ( NIN, * ) NUMA C IF ( NUMA .GT. NAMAX ) THEN ERRCNT = 1 WRITE ( NOUT, 1110 ) NUMA, NAMAX GO TO 900 END IF C READ ( NIN, * ) ( AVALUE(I), I = 1, NUMA ) C C ------------------------------ C ... PRINT USER SPECIFIED INPUT C ------------------------------ C WRITE ( NOUT, 1000 ) NAMOUT, NOUT, ERRMAX, THRESH WRITE ( NOUT, 1010 ) NUMNZ WRITE ( NOUT, 1020 ) ( NZVALU(I), I = 1, NUMNZ ) WRITE ( NOUT, 1030 ) NUMA WRITE ( NOUT, 1040 ) ( AVALUE(I), I = 1, NUMA ) C C ------------------------------- C ... VERIFY USER SPECIFIED INPUT C ------------------------------- C IF ( THRESH .LE. 0.0E0 ) THEN WRITE ( NOUT, 1130 ) THRESH THRESH = 10.0E0 END IF C IF ( NUMNZ .LE. 0 ) THEN WRITE ( NOUT, 1140 ) NUMNZ ERRCNT = 1 END IF C DO 100 I = 1, NUMNZ IF ( NZVALU(I) .GT. NZMAX ) THEN WRITE ( NOUT, 1150 ) I, NZVALU(I), NZMAX NZVALU(I) = NZMAX END IF 100 CONTINUE C IF ( ERRCNT .NE. 0 ) GO TO 900 C C --------------------------- C ... COMPUTE MACHINE EPSILON C --------------------------- C EPSILN = 1.0E0 EPSSAV = 1.0E0 C 200 IF ( SDIFF ( 1.0E0 + EPSILN, 1.0E0 ) .EQ. 0.0E0 ) GO TO 210 C EPSSAV = EPSILN EPSILN = EPSILN * .5E0 GO TO 200 C 210 EPSILN = EPSSAV C C ================================================================== C C -------------------------------- C ... TEST THE COMPLEX SPARSE BLAS C -------------------------------- C C ------------------ C ... CERTIFY CAXPYI C ------------------ C CALL TCXPYI ( NOUT, EPSILN, THRESH, NZMAX2, 1 NUMNZ, NZVALU, NUMA, AVALUE , 2 X, XSAVE, XTRUE, Y, YSAVE, YTRUE, 3 INDX, INDXT, LIST, ERRCNT, ERRMAX ) C C ------------------ C ... CERTIFY CDOTCI C ------------------ C CALL TCDTCI ( NOUT, EPSILN, THRESH, NZMAX2, 1 NUMNZ, NZVALU, 2 X, XSAVE, XTRUE, Y, YSAVE, YTRUE, 3 INDX, INDXT, ERRCNT, ERRMAX ) C C ------------------ C ... CERTIFY CDOTUI C ------------------ C CALL TCDTUI ( NOUT, EPSILN, THRESH, NZMAX2, 1 NUMNZ, NZVALU, 2 X, XSAVE, XTRUE, Y, YSAVE, YTRUE, 3 INDX, INDXT, ERRCNT, ERRMAX ) C C ----------------- C ... CERTIFY CGTHR C ----------------- C CALL TCGTHR ( NOUT, NZMAX2, NUMNZ, NZVALU, 1 X, XSAVE, XTRUE, Y, YSAVE, YTRUE, 2 INDX, INDXT, ERRCNT, ERRMAX ) C C ------------------ C ... CERTIFY CGTHRZ C ------------------ C CALL TCGTHZ ( NOUT, NZMAX2, NUMNZ, NZVALU, 1 X, XSAVE, XTRUE, Y, YSAVE, YTRUE, 2 INDX, INDXT, ERRCNT, ERRMAX ) C C ----------------- C ... CERTIFY CSCTR C ----------------- C CALL TCSCTR ( NOUT, NZMAX2, NUMNZ, NZVALU, 1 X, XSAVE, XTRUE, Y, YSAVE, YTRUE, 2 INDX, INDXT, ERRCNT, ERRMAX ) C C ================================================================== C C ------------------------------------- C ... PRINT GLOBAL PASS OR FAIL MESSAGE C ------------------------------------- C 900 IF ( ERRCNT .EQ. 0 ) THEN WRITE ( NOUT, 2000 ) ELSE WRITE ( NOUT, 2100 ) ERRCNT END IF C C -------------------------------------------------------- C ... END OF CERTIFICATION PROGRAM FOR COMPLEX SPARSE BLAS C -------------------------------------------------------- C STOP C C ================================================================== C C ----------- C ... FORMATS C ----------- C 1000 FORMAT( '1' /// 1 5X, 'START OF CERTIFICATION PROGRAM FOR THE COMPLEX ', 2 'SPARSE BLAS' 3 /5X, '-----------------------------------------------', 4 '-----------' 5 //5X, 'NAME OF OUTPUT UNIT = ', A 6 /5X, 'NUMBER OF OUTPUT UNIT = ', I10 7 /5X, 'MAX. NO. OF PRINTED ERROR MESSAGES = ', I10 8 /5X, 'THRESHOLD VALUE OF TEST RATIO = ', F10.1 ) C 1010 FORMAT ( /5X, 'NUMBER OF VALUES OF NZ = ', I10 ) C 1020 FORMAT ( /5X, 'VALUES OF NZ = ', 10I5 ) C 1030 FORMAT ( /5X, 'NUMBER OF VALUES OF A = ', I10 ) C 1040 FORMAT ( /5X, 'VALUES OF A = ', 1 3 ( 2X, '(', 1PE13.4, ',', 1PE13.4, ')' ) ) C 1100 FORMAT ( /5X, 'USER SPECIFIED NUMBER OF TEST CASES FOR THE ', 1 'NUMBER OF NONZEROES EXCEEDS PROGRAM LIMIT.' 2 /5X, 'NUMBER SPECIFIED = ', I10, 2X, 'PROGRAM LIMIT =', 3 I10 ) C 1110 FORMAT ( /5X, 'USER SPECIFIED NUMBER OF TEST CASES FOR THE ', 1 'SCALAR A EXCEEDS PROGRAM LIMIT.' 2 /5X, 'NUMBER SPECIFIED = ', I10, 2X, 'PROGRAM LIMIT =', 3 I10 ) C 1130 FORMAT ( /5X, 'USER SPECIFIED VALUE FOR THRESHOLD IS ', 1PE15.5, 1 ' WHICH IS NONPOSITIVE. IT HAS BEEN RESET TO 10.') C 1140 FORMAT ( /5X, 'USER SPECIFIED NUMBER OF VALUES OF NZ IS ', I5, 1 ' WHICH IS NONPOSITIVE. NO TESTING WILL OCCUR.' ) C 1150 FORMAT ( /5X, 'THE ', I3, '-TH USER SPECIFIED VALUE OF NZ IS ', 1 I8, ' IS LARGER THAN THE MAXIMUM ALLOWABLE ', 2 'VALUE OF NZ. IT HAS BEEN RESET TO ', I5 ) C 2000 FORMAT ( /5X, 'COMPLEX SPARSE BLAS HAVE PASSED ALL TESTS.' ) C 2100 FORMAT ( /5X, 'COMPLEX SPARSE BLAS HAVE FAILED ', I10, 1 ' TESTS. SEE ABOVE PRINTED ERROR MESSAGES.' ) C C ================================================================== C END SUBROUTINE TCXPYI ( NOUT, EPSILN, THRESH, NZMAX2, 1 NUMNZ, NZVALU, NUMA, AVALUE, 2 X, XSAVE, XTRUE, Y, YSAVE, 3 YTRUE , INDX, INDXT, LIST, ERRCNT, 4 ERRMAX ) C C ================================================================== C ================================================================== C ==== TCXPYI -- CERTIFY CAXPYI ==== C ================================================================== C ================================================================== C C SUBROUTINE TCXPYI IS THE CERTIFICATION MODULE FOR THE SPARSE C BASIC LINEAR ALGEBRA SUBROUTINE MODULE CAXPYI. C C WRITTEN BY ROGER G GRIMES C APRIL 1987 C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER NOUT, NZMAX2, NUMNZ, NUMA, ERRCNT, 1 ERRMAX C INTEGER NZVALU (*), INDX (*), INDXT (*), 1 LIST (*) C REAL EPSILN, THRESH C COMPLEX AVALUE (*), 1 X (*), XSAVE (*), XTRUE (*), 2 Y (*), YSAVE (*), YTRUE (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C COMPLEX A, ATRUE, CLOBBR C INTEGER COUNT, I, ICLOBR, J, KA, 1 KINDX, KNZ, N, NZ, NZTRUE C REAL ERR, S, T C C -------------------- C ... SUBPROGRAMS USED C -------------------- C LOGICAL IVSAME, CVSAME C EXTERNAL ICOPY, CCOPY, IINIT, CINIT, GNINDX, 1 IVSAME, CVSAME, CAXPYI C C ================================================================== C C ------------------ C ... INITIALIZATION C ------------------ C COUNT = 0 C CLOBBR = ( -1.0E10, -1.0E10 ) ICLOBR = -10000000 C C ------------------------------------ C ... GENERATE SOME VALUES FOR X AND Y C ------------------------------------ C DO 100 I = 1, NZMAX2 XSAVE(I) = CMPLX ( COS ( .6*FLOAT(I) ), SIN ( .2*FLOAT(I) ) ) YSAVE(I) = CMPLX ( SIN ( .7*FLOAT(I) ), COS ( .9*FLOAT(I) ) ) 100 CONTINUE C C ------------------------ C ... FOR EACH VALUE OF NZ C ------------------------ C DO 700 KNZ = 1, NUMNZ C NZTRUE = NZVALU(KNZ) N = 2 * MAX ( NZTRUE, 1 ) C C ----------------------- C ... FOR EACH VALUE OF A C ----------------------- C DO 600 KA = 1, NUMA C ATRUE = AVALUE(KA) C C ------------------------------- C ... FOR EACH KIND OF INDX ARRAY C ------------------------------- C DO 500 KINDX = 1, 5 C CALL GNINDX ( NZTRUE, N, ICLOBR, KINDX, INDXT ) C CALL IINIT ( N, -1, LIST, 1 ) C DO 150 I = 1, NZTRUE LIST (INDXT(I)) = I 150 CONTINUE C C ----------------------- C ... GENERATE INPUT DATA C ----------------------- C I = MIN ( N, N-NZTRUE ) J = N - I + 1 CALL CCOPY ( NZTRUE, XSAVE, 1, XTRUE, 1 ) CALL CINIT ( I, CLOBBR, XTRUE(J), 1 ) CALL CINIT ( N, CLOBBR, YTRUE, 1 ) C DO 200 I = 1, NZTRUE YTRUE (INDXT(I)) = YSAVE (INDXT(I)) 200 CONTINUE C C ------------------- C ... COPY TRUE INPUT C ------------------- C A = ATRUE NZ = NZTRUE C CALL CCOPY ( N, YTRUE, 1, Y, 1 ) CALL CCOPY ( N, XTRUE, 1, X, 1 ) CALL ICOPY ( N, INDXT, 1, INDX, 1 ) C C -------------------------- C ... COMPUTE IN-LINE RESULT C -------------------------- C DO 300 I = 1, NZTRUE YTRUE (INDXT(I)) = YTRUE (INDXT(I)) + 1 ATRUE * XTRUE(I) 300 CONTINUE C C --------------- C ... CALL CAXPYI C --------------- C CALL CAXPYI ( NZ, A, X, INDX, Y ) C C ----------------------------------------- C ... TEST ARGUMENTS OF CAXPYI THAT ARE NOT C SUPPOSED TO CHANGE. C ----------------------------------------- C IF ( NZ .NE. NZTRUE ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1000 ) NZTRUE, ATRUE, KINDX, 1 NZ END IF END IF C IF ( A .NE. ATRUE ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1100 ) NZTRUE, ATRUE, KINDX, 1 A END IF END IF C IF ( .NOT. CVSAME ( N, X, XTRUE ) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1200 ) NZTRUE, ATRUE, KINDX END IF END IF C IF ( .NOT. IVSAME ( N, INDX, INDXT ) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1300 ) NZTRUE, ATRUE, KINDX END IF END IF C C --------------------------- C ... TEST OUTPUT FROM CAXPYI C --------------------------- C DO 400 J = 1, N IF ( LIST(J) .EQ. -1 ) THEN IF ( Y(J) .NE. YTRUE(J) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1400 ) NZTRUE, ATRUE, 1 KINDX, J, 2 Y(J), YTRUE(J) END IF END IF C ELSE C S = ABS ( Y(J) - YTRUE(J) ) T = ABS ( ATRUE) * ABS ( XTRUE (LIST(J))) + 1 ABS ( YTRUE(J)) ERR = S / ( EPSILN * T ) IF ( ERR .GT. THRESH ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1500 ) NZTRUE, ATRUE, 1 KINDX, J, Y(J), 2 YTRUE(J), ERR END IF END IF C END IF C 400 CONTINUE C 500 CONTINUE C 600 CONTINUE C 700 CONTINUE C C ================================================================== C C ------------------ C ... END OF TESTING C ------------------ C ERRCNT = ERRCNT + COUNT IF ( COUNT .NE. 0 ) GO TO 800 C C ----------------------------------- C ... WRITE PASSED MESSAGE AND RETURN C ----------------------------------- C WRITE ( NOUT, 2700 ) GO TO 900 C C ----------------------------------- C ... WRITE FAILED MESSAGE AND RETURN C ----------------------------------- C 800 WRITE ( NOUT, 2800 ) COUNT C C ------------------------ C ... END OF MODULE TCXPYI C ------------------------ C 900 CONTINUE RETURN C C ================================================================== C C ----------- C ... FORMATS C ----------- C 1000 FORMAT ( 5X, 'CAXPYI ALTERED NZ FOR TEST WITH NZ = ', I5, 1 ' A = (', 1PE15.5, ',', 1PE15.5, 2 ') AND THE INDX TYPE NO. ', I5 3 /5X, 'ALTERED VALUE OF NZ = ', I5 ) C 1100 FORMAT ( 5X, 'CAXPYI ALTERED A FOR TEST WITH NZ = ', I5, 1 ' A = (', 1PE15.5, ',', 1PE15.5, 2 ') AND THE INDX TYPE NO. ', I5 3 /5X, 'ALTERED VALUE OF A = (', 1PE15.5, ',', 4 1PE15.5, ')' ) C 1200 FORMAT ( 5X, 'CAXPYI ALTERED ARRAY X FOR TEST WITH NZ = ', I5, 1 ' A = (', 1PE15.5, ',', 1PE15.5, 2 ') AND THE INDX TYPE NO. ', I5 ) C 1300 FORMAT ( 5X, 'CAXPYI ALTERED ARRAY INDX FOR TEST WITH NZ = ', I5, 1 ' A = (', 1PE15.5, ',', 1PE15.5, 2 ') AND THE INDX TYPE NO. ', I5 ) C 1400 FORMAT ( 5X, 'CAXPYI OUTPUT ARRAY Y IS INCORRECT FOR TEST WITH ', 1 'NZ = ', I5, ' A = (', 1PE15.5, ',', 1PE15.5, 2 ') AND THE INDX TYPE NO. ', I5 3 /5X, 'INCORRECT COMPONENT NO. ', I5, ' HAS VALUE = (', 4 1PE15.5, ',', 1PE15.5, 5 ') TRUE VALUE = (', 1PE15.5, ',', 1PE15.5, ')' ) C 1500 FORMAT ( 5X, 'CAXPYI OUTPUT ARRAY Y IS INACCURATE FOR TEST WITH ', 1 'NZ = ', I5, ' A = (', 1PE15.5, ',', 1PE15.5, 2 ') AND THE INDX TYPE NO. ', I5 3 /5X, 'INACCURATE COMPONENT NO. ', I5, ' HAS VALUE = (', 4 1PE15.5, ',', 1PE15.5, ') TRUE VALUE = (', 5 1PE15.5, ',', 1PE15.5, ')' 6 /5X, 'ERROR = ', 1PE12.1 ) C 2700 FORMAT ( /5X, 'CAXPYI PASSED ALL TESTS.' ) C 2800 FORMAT ( /5X, 'CAXPYI FAILED', I10, ' TESTS.' ) C C ================================================================== C END SUBROUTINE TCDTCI ( NOUT, EPSILN, THRESH, NZMAX2, 1 NUMNZ, NZVALU, 2 X, XSAVE, XTRUE, Y, YSAVE, 3 YTRUE , INDX, INDXT, ERRCNT, ERRMAX ) C C ================================================================== C ================================================================== C ==== TCDTCI -- CERTIFY CDOTCI ==== C ================================================================== C ================================================================== C C SUBROUTINE TCDTCI IS THE CERTIFICATION MODULE FOR THE SPARSE C BASIC LINEAR ALGEBRA SUBROUTINE MODULE CDOTCI. C C WRITTEN BY ROGER G GRIMES C APRIL 1987 C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER NOUT, NZMAX2, NUMNZ, ERRCNT, 1 ERRMAX C INTEGER NZVALU (*), INDX (*), INDXT (*) C REAL EPSILN, THRESH C COMPLEX X (*), XSAVE (*), XTRUE (*), 1 Y (*), YSAVE (*), YTRUE (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER COUNT, I, ICLOBR, J, KINDX, 1 KNZ, N, NZ, NZTRUE C REAL ERR, S, T C COMPLEX CLOBBR, V, W C C -------------------- C ... SUBPROGRAMS USED C -------------------- C LOGICAL IVSAME, CVSAME C COMPLEX CDOTCI C EXTERNAL ICOPY, CCOPY, CINIT, GNINDX, 1 IVSAME, CVSAME, CDOTCI C C ================================================================== C C ------------------ C ... INITIALIZATION C ------------------ C COUNT = 0 C CLOBBR = ( -1.0E10, -1.0E10 ) ICLOBR = -10000000 C C ------------------------------------ C ... GENERATE SOME VALUES FOR X AND Y C ------------------------------------ C DO 100 I = 1, NZMAX2 XSAVE(I) = CMPLX ( COS ( .6*FLOAT(I) ), SIN ( .2*FLOAT(I) ) ) YSAVE(I) = CMPLX ( SIN ( .7*FLOAT(I) ), COS ( .9*FLOAT(I) ) ) 100 CONTINUE C C ------------------------ C ... FOR EACH VALUE OF NZ C ------------------------ C DO 600 KNZ = 1, NUMNZ C NZTRUE = NZVALU(KNZ) N = 2 * MAX ( NZTRUE, 1 ) C C ------------------------------- C ... FOR EACH KIND OF INDX ARRAY C ------------------------------- C DO 500 KINDX = 1, 5 C CALL GNINDX ( NZTRUE, N, ICLOBR, KINDX, INDXT ) C C ----------------------- C ... GENERATE INPUT DATA C ----------------------- C I = MIN ( N, N-NZTRUE ) J = N - I + 1 CALL CCOPY ( NZTRUE, XSAVE, 1, XTRUE, 1 ) CALL CINIT ( I, CLOBBR, XTRUE(J), 1 ) CALL CINIT ( N, CLOBBR, YTRUE, 1 ) C DO 200 I = 1, NZTRUE YTRUE (INDXT(I)) = YSAVE (INDXT(I)) 200 CONTINUE C C ------------------- C ... COPY TRUE INPUT C ------------------- C NZ = NZTRUE C CALL CCOPY ( N, YTRUE, 1, Y, 1 ) CALL CCOPY ( N, XTRUE, 1, X, 1 ) CALL ICOPY ( N, INDXT, 1, INDX, 1 ) C C -------------------------- C ... COMPUTE IN-LINE RESULT C -------------------------- C V = ( 0.0E0, 0.0E0 ) C DO 300 I = 1, NZTRUE V = V + CONJG ( XTRUE(I) ) * YTRUE (INDXT(I)) 300 CONTINUE C C -------------- C ... CALL CDOTCI C -------------- C W = CDOTCI ( NZ, X, INDX, Y ) C C ----------------------------------------- C ... TEST ARGUMENTS OF CDOTCI THAT ARE NOT C SUPPOSED TO CHANGE. C ----------------------------------------- C IF ( NZ .NE. NZTRUE ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1000 ) NZTRUE, KINDX, NZ END IF END IF C IF ( .NOT. CVSAME ( N, X, XTRUE ) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1100 ) NZTRUE, KINDX END IF END IF C IF ( .NOT. IVSAME ( N, INDX, INDXT ) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1200 ) NZTRUE, KINDX END IF END IF C IF ( .NOT. CVSAME ( N, Y, YTRUE ) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1300 ) NZTRUE, KINDX END IF END IF C C -------------------------- C ... TEST OUTPUT FROM CDOTCI C -------------------------- C S = ABS ( V - W ) C T = 0.0E0 DO 400 I = 1, NZTRUE T = T + ABS ( XTRUE(I) * YTRUE (INDXT(I)) ) 400 CONTINUE C IF ( T .EQ. 0.0E0 ) T = 1.0E0 C ERR = S / ( EPSILN * T ) C IF ( ERR .GT. THRESH ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1400 ) NZTRUE, KINDX, 1 W, V, ERR END IF END IF C 500 CONTINUE C 600 CONTINUE C C ================================================================== C C ------------------ C ... END OF TESTING C ------------------ C ERRCNT = ERRCNT + COUNT IF ( COUNT .NE. 0 ) GO TO 800 C C ----------------------------------- C ... WRITE PASSED MESSAGE AND RETURN C ----------------------------------- C WRITE ( NOUT, 2700 ) GO TO 900 C C ----------------------------------- C ... WRITE FAILED MESSAGE AND RETURN C ----------------------------------- C 800 WRITE ( NOUT, 2800 ) COUNT C C ------------------------ C ... END OF MODULE TCDTCI C ------------------------ C 900 CONTINUE RETURN C C ================================================================== C C ----------- C ... FORMATS C ----------- C 1000 FORMAT ( 5X, 'CDOTCI ALTERED NZ FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5, 2 '. ALTERED VALUE OF NZ = ', I5 ) C 1100 FORMAT ( 5X, 'CDOTCI ALTERED ARRAY X FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5 ) C 1200 FORMAT ( 5X, 'CDOTCI ALTERED ARRAY INDX FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5 ) C 1300 FORMAT ( 5X, 'CDOTCI ALTERED ARRAY Y FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5 ) C 1400 FORMAT ( 5X, 'CDOTCI OUTPUT W IS INACCURATE FOR TEST WITH ', 1 'NZ = ', I5, ' AND THE INDX TYPE NO. ', I5 2 /5X, 'CDOTCI HAS VALUE = (', 1PE15.5, ',', 1PE15.5, 3 ') TRUE VALUE = (', 1PE15.5, ',', 1PE15.5, 4 ') ERROR = ', 1PE12.1 ) C 2700 FORMAT ( /5X, 'CDOTCI PASSED ALL TESTS.' ) C 2800 FORMAT ( /5X, 'CDOTCI FAILED', I10, ' TESTS.' ) C C ================================================================== C END SUBROUTINE TCDTUI ( NOUT, EPSILN, THRESH, NZMAX2, 1 NUMNZ, NZVALU, 2 X, XSAVE, XTRUE, Y, YSAVE, 3 YTRUE , INDX, INDXT, ERRCNT, ERRMAX ) C C ================================================================== C ================================================================== C ==== TCDTUI -- CERTIFY CDOTUI ==== C ================================================================== C ================================================================== C C SUBROUTINE TCDTUI IS THE CERTIFICATION MODULE FOR THE SPARSE C BASIC LINEAR ALGEBRA SUBROUTINE MODULE CDOTUI. C C WRITTEN BY ROGER G GRIMES C APRIL 1987 C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER NOUT, NZMAX2, NUMNZ, ERRCNT, 1 ERRMAX C INTEGER NZVALU (*), INDX (*), INDXT (*) C REAL EPSILN, THRESH C COMPLEX X (*), XSAVE (*), XTRUE (*), 1 Y (*), YSAVE (*), YTRUE (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER COUNT, I, ICLOBR, J, KINDX, 1 KNZ, N, NZ, NZTRUE C REAL ERR, S, T C COMPLEX CLOBBR, V, W C C -------------------- C ... SUBPROGRAMS USED C -------------------- C LOGICAL IVSAME, CVSAME C COMPLEX CDOTUI C EXTERNAL ICOPY, CCOPY, CINIT, GNINDX, 1 IVSAME, CVSAME, CDOTUI C C ================================================================== C C ------------------ C ... INITIALIZATION C ------------------ C COUNT = 0 C CLOBBR = ( -1.0E10, -1.0E10 ) ICLOBR = -10000000 C C ------------------------------------ C ... GENERATE SOME VALUES FOR X AND Y C ------------------------------------ C DO 100 I = 1, NZMAX2 XSAVE(I) = CMPLX ( COS ( .6*FLOAT(I) ), SIN ( .2*FLOAT(I) ) ) YSAVE(I) = CMPLX ( SIN ( .7*FLOAT(I) ), COS ( .9*FLOAT(I) ) ) 100 CONTINUE C C ------------------------ C ... FOR EACH VALUE OF NZ C ------------------------ C DO 600 KNZ = 1, NUMNZ C NZTRUE = NZVALU(KNZ) N = 2 * MAX ( NZTRUE, 1 ) C C ------------------------------- C ... FOR EACH KIND OF INDX ARRAY C ------------------------------- C DO 500 KINDX = 1, 5 C CALL GNINDX ( NZTRUE, N, ICLOBR, KINDX, INDXT ) C C ----------------------- C ... GENERATE INPUT DATA C ----------------------- C I = MIN ( N, N-NZTRUE ) J = N - I + 1 CALL CCOPY ( NZTRUE, XSAVE, 1, XTRUE, 1 ) CALL CINIT ( I, CLOBBR, XTRUE(J), 1 ) CALL CINIT ( N, CLOBBR, YTRUE, 1 ) C DO 200 I = 1, NZTRUE YTRUE (INDXT(I)) = YSAVE (INDXT(I)) 200 CONTINUE C C ------------------- C ... COPY TRUE INPUT C ------------------- C NZ = NZTRUE C CALL CCOPY ( N, YTRUE, 1, Y, 1 ) CALL CCOPY ( N, XTRUE, 1, X, 1 ) CALL ICOPY ( N, INDXT, 1, INDX, 1 ) C C -------------------------- C ... COMPUTE IN-LINE RESULT C -------------------------- C V = ( 0.0E0, 0.0E0 ) C DO 300 I = 1, NZTRUE V = V + XTRUE(I) * YTRUE (INDXT(I)) 300 CONTINUE C C -------------- C ... CALL CDOTUI C -------------- C W = CDOTUI ( NZ, X, INDX, Y ) C C ----------------------------------------- C ... TEST ARGUMENTS OF CDOTUI THAT ARE NOT C SUPPOSED TO CHANGE. C ----------------------------------------- C IF ( NZ .NE. NZTRUE ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1000 ) NZTRUE, KINDX, NZ END IF END IF C IF ( .NOT. CVSAME ( N, X, XTRUE ) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1100 ) NZTRUE, KINDX END IF END IF C IF ( .NOT. IVSAME ( N, INDX, INDXT ) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1200 ) NZTRUE, KINDX END IF END IF C IF ( .NOT. CVSAME ( N, Y, YTRUE ) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1300 ) NZTRUE, KINDX END IF END IF C C -------------------------- C ... TEST OUTPUT FROM CDOTUI C -------------------------- C S = ABS ( V - W ) C T = 0.0E0 DO 400 I = 1, NZTRUE T = T + ABS ( XTRUE(I) * YTRUE (INDXT(I)) ) 400 CONTINUE C IF ( T .EQ. 0.0E0 ) T = 1.0E0 C ERR = S / ( EPSILN * T ) C IF ( ERR .GT. THRESH ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1400 ) NZTRUE, KINDX, 1 W, V, ERR END IF END IF C 500 CONTINUE C 600 CONTINUE C C ================================================================== C C ------------------ C ... END OF TESTING C ------------------ C ERRCNT = ERRCNT + COUNT IF ( COUNT .NE. 0 ) GO TO 800 C C ----------------------------------- C ... WRITE PASSED MESSAGE AND RETURN C ----------------------------------- C WRITE ( NOUT, 2700 ) GO TO 900 C C ----------------------------------- C ... WRITE FAILED MESSAGE AND RETURN C ----------------------------------- C 800 WRITE ( NOUT, 2800 ) COUNT C C ------------------------ C ... END OF MODULE TCDTUI C ------------------------ C 900 CONTINUE RETURN C C ================================================================== C C ----------- C ... FORMATS C ----------- C 1000 FORMAT ( 5X, 'CDOTUI ALTERED NZ FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5, 2 '. ALTERED VALUE OF NZ = ', I5 ) C 1100 FORMAT ( 5X, 'CDOTUI ALTERED ARRAY X FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5 ) C 1200 FORMAT ( 5X, 'CDOTUI ALTERED ARRAY INDX FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5 ) C 1300 FORMAT ( 5X, 'CDOTUI ALTERED ARRAY Y FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5 ) C 1400 FORMAT ( 5X, 'CDOTUI OUTPUT W IS INACCURATE FOR TEST WITH ', 1 'NZ = ', I5, ' AND THE INDX TYPE NO. ', I5 2 /5X, 'CDOTUI HAS VALUE = (', 1PE15.5, ',', 1PE15.5, 3 ') TRUE VALUE = (', 1PE15.5, ',', 1PE15.5, 4 ') ERROR = ', 1PE12.1 ) C 2700 FORMAT ( /5X, 'CDOTUI PASSED ALL TESTS.' ) C 2800 FORMAT ( /5X, 'CDOTUI FAILED', I10, ' TESTS.' ) C C ================================================================== C END SUBROUTINE TCGTHR ( NOUT, NZMAX2, NUMNZ, NZVALU, 1 X, XSAVE, XTRUE, Y, YSAVE, 2 YTRUE , INDX, INDXT, ERRCNT, ERRMAX ) C C ================================================================== C ================================================================== C ==== TCGTHR -- CERTIFY CGTHR ==== C ================================================================== C ================================================================== C C SUBROUTINE TCGTHR IS THE CERTIFICATION MODULE FOR THE SPARSE C BASIC LINEAR ALGEBRA SUBROUTINE MODULE CGTHR. C C WRITTEN BY ROGER G GRIMES C APRIL 1987 C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER NOUT, NZMAX2, NUMNZ, ERRCNT, 1 ERRMAX C INTEGER NZVALU (*), INDX (*), INDXT (*) C COMPLEX X (*), XSAVE (*), XTRUE (*), 1 Y (*), YSAVE (*), YTRUE (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER COUNT, I, ICLOBR, KINDX, 1 KNZ, N, NZ, NZTRUE C COMPLEX CLOBBR C C -------------------- C ... SUBPROGRAMS USED C -------------------- C LOGICAL IVSAME, CVSAME C EXTERNAL ICOPY, CCOPY, CINIT, GNINDX, 1 IVSAME, CVSAME, CGTHR C C ================================================================== C C ------------------ C ... INITIALIZATION C ------------------ C COUNT = 0 C CLOBBR = ( -1.0E10, -1.0E10 ) ICLOBR = -10000000 C C ------------------------------------ C ... GENERATE SOME VALUES FOR X AND Y C ------------------------------------ C DO 100 I = 1, NZMAX2 XSAVE(I) = CMPLX ( COS ( .6*FLOAT(I) ), SIN ( .2*FLOAT(I) ) ) YSAVE(I) = CMPLX ( SIN ( .7*FLOAT(I) ), COS ( .9*FLOAT(I) ) ) 100 CONTINUE C C ------------------------ C ... FOR EACH VALUE OF NZ C ------------------------ C DO 600 KNZ = 1, NUMNZ C NZTRUE = NZVALU(KNZ) N = 2 * MAX ( NZTRUE, 1 ) C C ------------------------------- C ... FOR EACH KIND OF INDX ARRAY C ------------------------------- C DO 500 KINDX = 1, 5 C CALL GNINDX ( NZTRUE, N, ICLOBR, KINDX, INDXT ) C C ----------------------- C ... GENERATE INPUT DATA C ----------------------- C CALL CINIT ( N, CLOBBR, XTRUE, 1 ) CALL CINIT ( N, CLOBBR, YTRUE, 1 ) C DO 200 I = 1, NZTRUE YTRUE (INDXT(I)) = YSAVE (INDXT(I)) 200 CONTINUE C C ------------------- C ... COPY TRUE INPUT C ------------------- C NZ = NZTRUE C CALL CCOPY ( N, YTRUE, 1, Y, 1 ) CALL CCOPY ( N, XTRUE, 1, X, 1 ) CALL ICOPY ( N, INDXT, 1, INDX, 1 ) C C -------------------------- C ... COMPUTE IN-LINE RESULT C -------------------------- C DO 300 I = 1, NZTRUE XTRUE (I) = YTRUE (INDXT(I)) 300 CONTINUE C C -------------- C ... CALL CGTHR C -------------- C CALL CGTHR ( NZ, Y, X, INDX ) C C ---------------------------------------- C ... TEST ARGUMENTS OF CGTHR THAT ARE NOT C SUPPOSED TO CHANGE. C ---------------------------------------- C IF ( NZ .NE. NZTRUE ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1000 ) NZTRUE, KINDX, NZ END IF END IF C IF ( .NOT. CVSAME ( N, Y, YTRUE ) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1100 ) NZTRUE, KINDX END IF END IF C IF ( .NOT. IVSAME ( N, INDX, INDXT ) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1200 ) NZTRUE, KINDX END IF END IF C C -------------------------- C ... TEST OUTPUT FROM CGTHR C -------------------------- C DO 400 I = 1, N IF ( X(I) .NE. XTRUE(I) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1300 ) NZTRUE, KINDX, I, 1 X(I), XTRUE(I) END IF END IF 400 CONTINUE C 500 CONTINUE C 600 CONTINUE C C ================================================================== C C ------------------ C ... END OF TESTING C ------------------ C ERRCNT = ERRCNT + COUNT IF ( COUNT .NE. 0 ) GO TO 800 C C ----------------------------------- C ... WRITE PASSED MESSAGE AND RETURN C ----------------------------------- C WRITE ( NOUT, 2700 ) GO TO 900 C C ----------------------------------- C ... WRITE FAILED MESSAGE AND RETURN C ----------------------------------- C 800 WRITE ( NOUT, 2800 ) COUNT C C ------------------------ C ... END OF MODULE TCGTHR C ------------------------ C 900 CONTINUE RETURN C C ================================================================== C C ----------- C ... FORMATS C ----------- C 1000 FORMAT ( 5X, 'CGTHR ALTERED NZ FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5, 2 '. ALTERED VALUE OF NZ = ', I5 ) C 1100 FORMAT ( 5X, 'CGTHR ALTERED ARRAY Y FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5 ) C 1200 FORMAT ( 5X, 'CGTHR ALTERED ARRAY INDX FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5 ) C 1300 FORMAT ( 5X, 'CGTHR OUTPUT ARRAY X IS INCORRECT FOR TEST WITH ', 1 'NZ = ', I5, ' AND THE INDX TYPE NO. ', I5 2 /5X, 'INACCURATE COMPONENT NO. ', I5, ' HAS VALUE = (', 3 1PE15.5, ',', 1PE15.5, ') TRUE VALUE = (', 4 1PE15.5, ',', 1PE15.5, ')' ) C 2700 FORMAT ( /5X, 'CGTHR PASSED ALL TESTS.' ) C 2800 FORMAT ( /5X, 'CGTHR FAILED', I10, ' TESTS.' ) C C ================================================================== C END SUBROUTINE TCGTHZ ( NOUT, NZMAX2, NUMNZ, NZVALU, 1 X, XSAVE, XTRUE, Y, YSAVE, 2 YTRUE , INDX, INDXT, ERRCNT, ERRMAX ) C C ================================================================== C ================================================================== C ==== TCGTHZ -- CERTIFY CGTHRZ ==== C ================================================================== C ================================================================== C C SUBROUTINE TCGTHZ IS THE CERTIFICATION MODULE FOR THE SPARSE C BASIC LINEAR ALGEBRA SUBROUTINE MODULE CGTHRZ. C C WRITTEN BY ROGER G GRIMES C APRIL 1987 C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER NOUT, NZMAX2, NUMNZ, ERRCNT, 1 ERRMAX C INTEGER NZVALU (*), INDX (*), INDXT (*) C COMPLEX X (*), XSAVE (*), XTRUE (*), 1 Y (*), YSAVE (*), YTRUE (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER COUNT, I, ICLOBR, KINDX, 1 KNZ, N, NZ, NZTRUE C COMPLEX CLOBBR C C -------------------- C ... SUBPROGRAMS USED C -------------------- C LOGICAL IVSAME, CVSAME C EXTERNAL ICOPY, CCOPY, CINIT, GNINDX, 1 IVSAME, CVSAME, CGTHRZ C C ================================================================== C C ------------------ C ... INITIALIZATION C ------------------ C COUNT = 0 C CLOBBR = ( -1.0E10, -1.0E10 ) ICLOBR = -10000000 C C ------------------------------------ C ... GENERATE SOME VALUES FOR X AND Y C ------------------------------------ C DO 100 I = 1, NZMAX2 XSAVE(I) = CMPLX ( COS ( .6*FLOAT(I) ), SIN ( .2*FLOAT(I) ) ) YSAVE(I) = CMPLX ( SIN ( .7*FLOAT(I) ), COS ( .9*FLOAT(I) ) ) 100 CONTINUE C C ------------------------ C ... FOR EACH VALUE OF NZ C ------------------------ C DO 600 KNZ = 1, NUMNZ C NZTRUE = NZVALU(KNZ) N = 2 * MAX ( NZTRUE, 1 ) C C ------------------------------- C ... FOR EACH KIND OF INDX ARRAY C ------------------------------- C DO 500 KINDX = 1, 5 C CALL GNINDX ( NZTRUE, N, ICLOBR, KINDX, INDXT ) C C ----------------------- C ... GENERATE INPUT DATA C ----------------------- C CALL CINIT ( N, CLOBBR, XTRUE, 1 ) CALL CINIT ( N, CLOBBR, YTRUE, 1 ) C DO 200 I = 1, NZTRUE YTRUE (INDXT(I)) = YSAVE (INDXT(I)) 200 CONTINUE C C ------------------- C ... COPY TRUE INPUT C ------------------- C NZ = NZTRUE C CALL CCOPY ( N, YTRUE, 1, Y, 1 ) CALL CCOPY ( N, XTRUE, 1, X, 1 ) CALL ICOPY ( N, INDXT, 1, INDX, 1 ) C C -------------------------- C ... COMPUTE IN-LINE RESULT C -------------------------- C DO 300 I = 1, NZTRUE XTRUE (I) = YTRUE (INDXT(I)) YTRUE(INDXT(I)) = ( 0.0E0, 0.0E0 ) 300 CONTINUE C C --------------- C ... CALL CGTHRZ C --------------- C CALL CGTHRZ ( NZ, Y, X, INDX ) C C ----------------------------------------- C ... TEST ARGUMENTS OF CGTHRZ THAT ARE NOT C SUPPOSED TO CHANGE. C ----------------------------------------- C IF ( NZ .NE. NZTRUE ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1000 ) NZTRUE, KINDX, NZ END IF END IF C IF ( .NOT. IVSAME ( N, INDX, INDXT ) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1100 ) NZTRUE, KINDX END IF END IF C C --------------------------- C ... TEST OUTPUT FROM CGTHRZ C --------------------------- C DO 400 I = 1, N C IF ( X(I) .NE. XTRUE(I) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1200 ) NZTRUE, KINDX, I, 1 X(I), XTRUE(I) END IF END IF C IF ( Y(I) .NE. YTRUE(I) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1300 ) NZTRUE, KINDX, I, 1 Y(I), YTRUE(I) END IF END IF C 400 CONTINUE C 500 CONTINUE C 600 CONTINUE C C ================================================================== C C ------------------ C ... END OF TESTING C ------------------ C ERRCNT = ERRCNT + COUNT IF ( COUNT .NE. 0 ) GO TO 800 C C ----------------------------------- C ... WRITE PASSED MESSAGE AND RETURN C ----------------------------------- C WRITE ( NOUT, 2700 ) GO TO 900 C C ----------------------------------- C ... WRITE FAILED MESSAGE AND RETURN C ----------------------------------- C 800 WRITE ( NOUT, 2800 ) COUNT C C ------------------------ C ... END OF MODULE TCGTHZ C ------------------------ C 900 CONTINUE RETURN C C ================================================================== C C ----------- C ... FORMATS C ----------- C 1000 FORMAT ( 5X, 'CGTHRZ ALTERED NZ FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5, 2 '. ALTERED VALUE OF NZ = ', I5 ) C 1100 FORMAT ( 5X, 'CGTHRZ ALTERED ARRAY INDX FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5 ) C 1200 FORMAT ( 5X, 'CGTHRZ OUTPUT ARRAY X IS INCORRECT FOR TEST WITH ', 1 'NZ = ', I5, ' AND THE INDX TYPE NO. ', I5 2 /5X, 'INACCURATE COMPONENT NO. ', I5, ' HAS VALUE = (', 3 1PE15.5, ',', 1PE15.5, ') TRUE VALUE = (', 4 1PE15.5, ',', 1PE15.5, ')' ) C 1300 FORMAT ( 5X, 'CGTHRZ OUTPUT ARRAY Y IS INCORRECT FOR TEST WITH ', 1 'NZ = ', I5, ' AND THE INDX TYPE NO. ', I5 2 /5X, 'INACCURATE COMPONENT NO. ', I5, ' HAS VALUE = (', 3 1PE15.5, ',', 1PE15.5, ') TRUE VALUE = (', 4 1PE15.5, ',', 1PE15.5, ')' ) C 2700 FORMAT ( /5X, 'CGTHRZ PASSED ALL TESTS.' ) C 2800 FORMAT ( /5X, 'CGTHRZ FAILED', I10, ' TESTS.' ) C C ================================================================== C END SUBROUTINE TCSCTR ( NOUT, NZMAX2, NUMNZ, NZVALU, 1 X, XSAVE, XTRUE, Y, YSAVE, 2 YTRUE , INDX, INDXT, ERRCNT, ERRMAX ) C C ================================================================== C ================================================================== C ==== TCSCTR -- CERTIFY CSCTR ==== C ================================================================== C ================================================================== C C SUBROUTINE TCSCTR IS THE CERTIFICATION MODULE FOR THE SPARSE C BASIC LINEAR ALGEBRA SUBROUTINE MODULE CSCTR. C C WRITTEN BY ROGER G GRIMES C APRIL 1987 C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER NOUT, NZMAX2, NUMNZ, ERRCNT, 1 ERRMAX C INTEGER NZVALU (*), INDX (*), INDXT (*) C COMPLEX X (*), XSAVE (*), XTRUE (*), 1 Y (*), YSAVE (*), YTRUE (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER COUNT, I, ICLOBR, J, KINDX, 1 KNZ, N, NZ, NZTRUE C COMPLEX CLOBBR C C -------------------- C ... SUBPROGRAMS USED C -------------------- C LOGICAL IVSAME, CVSAME C EXTERNAL ICOPY, CCOPY, CINIT, GNINDX, 1 IVSAME, CVSAME, CSCTR C C ================================================================== C C ------------------ C ... INITIALIZATION C ------------------ C COUNT = 0 C CLOBBR = ( -1.0E10, -1.0E10 ) ICLOBR = -10000000 C C ------------------------------------ C ... GENERATE SOME VALUES FOR X AND Y C ------------------------------------ C DO 100 I = 1, NZMAX2 XSAVE(I) = CMPLX ( COS ( .6*FLOAT(I) ), SIN ( .2*FLOAT(I) ) ) YSAVE(I) = CMPLX ( SIN ( .7*FLOAT(I) ), COS ( .9*FLOAT(I) ) ) 100 CONTINUE C C ------------------------ C ... FOR EACH VALUE OF NZ C ------------------------ C DO 600 KNZ = 1, NUMNZ C NZTRUE = NZVALU(KNZ) N = 2 * MAX ( NZTRUE, 1 ) C C ------------------------------- C ... FOR EACH KIND OF INDX ARRAY C ------------------------------- C DO 500 KINDX = 1, 5 C CALL GNINDX ( NZTRUE, N, ICLOBR, KINDX, INDXT ) C C ----------------------- C ... GENERATE INPUT DATA C ----------------------- C I = MIN ( N, N-NZTRUE ) J = N - I + 1 CALL CCOPY ( NZTRUE, XSAVE, 1, XTRUE, 1 ) CALL CINIT ( I, CLOBBR, XTRUE(J), 1 ) CALL CINIT ( N, CLOBBR, YTRUE, 1 ) C C ------------------- C ... COPY TRUE INPUT C ------------------- C NZ = NZTRUE C CALL CCOPY ( N, YTRUE, 1, Y, 1 ) CALL CCOPY ( N, XTRUE, 1, X, 1 ) CALL ICOPY ( N, INDXT, 1, INDX, 1 ) C C -------------------------- C ... COMPUTE IN-LINE RESULT C -------------------------- C DO 300 I = 1, NZTRUE YTRUE (INDXT(I)) = XTRUE (I) 300 CONTINUE C C -------------- C ... CALL CSCTR C -------------- C CALL CSCTR ( NZ, X, INDX, Y ) C C ---------------------------------------- C ... TEST ARGUMENTS OF CSCTR THAT ARE NOT C SUPPOSED TO CHANGE. C ---------------------------------------- C IF ( NZ .NE. NZTRUE ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1000 ) NZTRUE, KINDX, NZ END IF END IF C IF ( .NOT. CVSAME ( N, X, XTRUE ) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1100 ) NZTRUE, KINDX END IF END IF C IF ( .NOT. IVSAME ( N, INDX, INDXT ) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1200 ) NZTRUE, KINDX END IF END IF C C -------------------------- C ... TEST OUTPUT FROM CSCTR C -------------------------- C DO 400 I = 1, N IF ( Y(I) .NE. YTRUE(I) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1300 ) NZTRUE, KINDX, I, 1 Y(I), YTRUE(I) END IF END IF 400 CONTINUE C 500 CONTINUE C 600 CONTINUE C C ================================================================== C C ------------------ C ... END OF TESTING C ------------------ C ERRCNT = ERRCNT + COUNT IF ( COUNT .NE. 0 ) GO TO 800 C C ----------------------------------- C ... WRITE PASSED MESSAGE AND RETURN C ----------------------------------- C WRITE ( NOUT, 2700 ) GO TO 900 C C ----------------------------------- C ... WRITE FAILED MESSAGE AND RETURN C ----------------------------------- C 800 WRITE ( NOUT, 2800 ) COUNT C C ------------------------ C ... END OF MODULE TCSCTR C ------------------------ C 900 CONTINUE RETURN C C ================================================================== C C ----------- C ... FORMATS C ----------- C 1000 FORMAT ( 5X, 'CSCTR ALTERED NZ FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5, 2 '. ALTERED VALUE OF NZ = ', I5 ) C 1100 FORMAT ( 5X, 'CSCTR ALTERED ARRAY X FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5 ) C 1200 FORMAT ( 5X, 'CSCTR ALTERED ARRAY INDX FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5 ) C 1300 FORMAT ( 5X, 'CSCTR OUTPUT ARRAY Y IS INCORRECT FOR TEST WITH ', 1 'NZ = ', I5, ' AND THE INDX TYPE NO. ', I5 2 /5X, 'INACCURATE COMPONENT NO. ', I5, ' HAS VALUE = (', 3 1PE15.5, ',', 1PE15.5, ') TRUE VALUE = (', 4 1PE15.5, ',', 1PE15.5, ')' ) C 2700 FORMAT ( /5X, 'CSCTR PASSED ALL TESTS.' ) C 2800 FORMAT ( /5X, 'CSCTR FAILED', I10, ' TESTS.' ) C C ================================================================== C END REAL FUNCTION SDIFF ( X, Y ) C C ================================================================== C C SDIFF IS USED BY THE MAIN PROGRAM TO COMPARE 1.0 + EPSILN WITH C 1.0. ITS SOLE USE IS TO FOOL AN OPTIMIZING COMPILER. C C ================================================================== C C ------------------------ C ... VARIABLE DECLARATION C ------------------------ C REAL X, Y C C ================================================================== C SDIFF = X - Y C C ================================================================== C RETURN END LOGICAL FUNCTION CVSAME ( N, CX, CY ) C C ================================================================== C C LOGICAL FUNCTION CVSAME DETERMINES IF THE VECTORS CX AND CY C AGREE EXACTLY WITH EACH OTHER. C C ================================================================== C C ------------------------ C ... VARIABLE DECLARATION C ------------------------ C INTEGER I, N C COMPLEX CX (*), CY (*) C C ================================================================== C CVSAME = .TRUE. C DO 10 I = 1, N IF ( CX(I) .NE. CY(I) ) THEN CVSAME = .FALSE. GO TO 20 ENDIF 10 CONTINUE C 20 RETURN END SUBROUTINE ICOPY ( N, X, INCX, Y, INCY ) C C ================================================================== C ================================================================== C ==== ICOPY -- COPY ONE INTEGER VECTOR TO ANOTHER ==== C ================================================================== C ================================================================== C C PURPOSE ... (VARIANT OF 'SCOPY') C COPY ONE INTEGER VECTOR TO ANOTHER. C STANDARD INCREMENT OF 1 SHOULD BE USED FOR FORWARD C COPY WITHIN SAME VECTOR. C C CREATED ... MAR. 12, 1985 C LAST MODIFIED ... APR. 19, 1985 C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER N, INCX, INCY C INTEGER X (*), Y (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER XADDR, YADDR, I C C ================================================================== C IF ( INCX .EQ. 1 .AND. INCY .EQ. 1 ) THEN C C ----------------------------------- C ... UNIT INCREMENTS (STANDARD CASE) C ----------------------------------- C DO 100 I = 1, N Y (I) = X (I) 100 CONTINUE C ELSE C C ------------------------- C ... NON-UNIT INCREMENTS C (-1) USED FOR REVERSE C COPYING IN SAME ARRAY C ------------------------- C XADDR = 1 YADDR = 1 C IF ( INCX .LT. 0 ) THEN XADDR = (-N+1)*INCX + 1 ENDIF C IF ( INCY .LT. 0 ) THEN YADDR = (-N+1)*INCY + 1 ENDIF C DO 200 I = 1, N Y (YADDR) = X (XADDR) XADDR = XADDR + INCX YADDR = YADDR + INCY 200 CONTINUE C ENDIF C RETURN C END SUBROUTINE IINIT ( N, A, X, INCX ) C C ================================================================== C ================================================================== C ==== IINIT -- INITIALIZE INTEGER VECTOR TO CONSTANT ==== C ================================================================== C ================================================================== C C PURPOSE ... INITIALIZES INTEGER VECTOR TO A CONSTANT VALUE 'A' C C CREATED ... MAR. 8, 1985 C LAST MODIFIED ... APR. 19, 1985 C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER N, INCX C INTEGER A, X (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER XADDR, I C C ================================================================== C IF ( INCX .EQ. 1 ) THEN C C ---------------------------------- C ... UNIT INCREMENT (STANDARD CASE) C ---------------------------------- C DO 100 I = 1, N X(I) = A 100 CONTINUE C ELSE C C ---------------------- C ... NON-UNIT INCREMENT C ---------------------- C XADDR = 1 IF ( INCX .LT. 0 ) THEN XADDR = (-N+1)*INCX + 1 ENDIF C DO 200 I = 1, N X (XADDR) = A XADDR = XADDR + INCX 200 CONTINUE C ENDIF C RETURN C END SUBROUTINE GNINDX ( NZ, N, ICLOBR, KINDX, INDX ) C C ================================================================== C ================================================================== C ==== GNINDX -- GENERATE INDEX ARRAY PATTERNS ==== C ================================================================== C ================================================================== C C GNINDX GENERATES VARIOUS PATTERNS FOR THE ARRAY INDX BASED C ON THE KEY KINDX. THE GENERATED INDX ARRAY HAS NZ SIGNIFICANT C COMPONENTS. THE REMAINING N-NZ COMPONENTS ARE SET TO C ICLOBR. C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER NZ, N, ICLOBR, KINDX, INDX (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER I, L C C -------------------- C ... SUBPROGRAMS USED C -------------------- C EXTERNAL IINIT C C ================================================================== C IF ( N .LE. 0 ) RETURN C L = MAX ( N, N-NZ ) CALL IINIT ( L, ICLOBR, INDX, 1 ) C IF ( NZ .LE. 0 ) RETURN C KINDX = MAX ( KINDX, 1 ) KINDX = MIN ( KINDX, 5 ) C C ------------------- C ... BRANCH ON KINDX C ------------------- C GO TO ( 100, 200, 300, 400, 500 ), KINDX C C ----------------------------------- C ... ASCENDING ORDER - 1, 2, ..., NZ C ----------------------------------- C 100 DO 110 I = 1, NZ INDX(I) = I 110 CONTINUE GO TO 900 C C ------------------------------------------ C ... ASCENDING ORDER - N-NZ+1, N-NZ, ..., N C ------------------------------------------ C 200 L = N - NZ DO 210 I = 1, NZ INDX(I) = L + I 210 CONTINUE GO TO 900 C C --------------------------------------- C ... DESCENDING ORDER - NZ, NZ-1, ..., 1 C --------------------------------------- C 300 L = NZ DO 310 I = 1, NZ INDX(I) = L L = L -1 310 CONTINUE GO TO 900 C C ------------------------------------------ C ... DESCENDING ORDER - N, N-1, ..., N-NZ+1 C ------------------------------------------ C 400 L = N DO 410 I = 1, NZ INDX(I) = L L = L - 1 410 CONTINUE GO TO 900 C C -------------------------------------------------------- C ... ALTERNATING ORDER WITH EVEN NUMBERS IN REVERSE ORDER C -------------------------------------------------------- C 500 DO 510 I = 1, NZ, 2 INDX(I) = I 510 CONTINUE C L = N DO 520 I = 2, NZ, 2 INDX(I) = L L = L - 2 520 CONTINUE GO TO 900 C C ================================================================== C 900 RETURN END LOGICAL FUNCTION IVSAME ( N, IX, IY ) C C ================================================================== C C LOGICAL FUNCTION IVSAME DETERMINES IF THE VECTORS IX AND IY C AGREE EXACTLY WITH EACH OTHER. C C ================================================================== C C ------------------------ C ... VARIABLE DECLARATION C ------------------------ C INTEGER I, N, IX (*), IY (*) C C ================================================================== C IVSAME = .TRUE. C IF ( N .LE. 0 ) RETURN C DO 10 I = 1, N IF ( IX(I) .NE. IY(I) ) THEN IVSAME = .FALSE. GO TO 20 ENDIF 10 CONTINUE C 20 RETURN C END SUBROUTINE CCOPY ( N, X, INCX, Y, INCY ) C C ================================================================== C ================================================================== C ==== CCOPY -- COPY ONE COMPLEX VECTOR TO ANOTHER ==== C ================================================================== C ================================================================== C C PURPOSE ... STANDARD BLAS C COPY ONE COMPLEX VECTOR TO ANOTHER. C STANDARD INCREMENT OF 1 SHOULD BE USED FOR FORWARD C COPY WITHIN SAME VECTOR. C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER N, INCX, INCY C COMPLEX X (*), Y (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER XADDR, YADDR, I C C ================================================================== C IF ( INCX .EQ. 1 .AND. INCY .EQ. 1 ) THEN C C ----------------------------------- C ... UNIT INCREMENTS (STANDARD CASE) C ----------------------------------- C DO 100 I = 1, N Y (I) = X (I) 100 CONTINUE C ELSE C C ------------------------- C ... NON-UNIT INCREMENTS C (-1) USED FOR REVERSE C COPYING IN SAME ARRAY C ------------------------- C XADDR = 1 YADDR = 1 C IF ( INCX .LT. 0 ) THEN XADDR = (-N+1)*INCX + 1 ENDIF C IF ( INCY .LT. 0 ) THEN YADDR = (-N+1)*INCY + 1 ENDIF C DO 200 I = 1, N Y (YADDR) = X (XADDR) XADDR = XADDR + INCX YADDR = YADDR + INCY 200 CONTINUE C ENDIF C RETURN C END SUBROUTINE CINIT ( N, A, X, INCX ) C C ================================================================== C ================================================================== C ==== CINIT -- INITIALIZE COMPLEX VECTOR TO CONSTANT ==== C ================================================================== C ================================================================== C C PURPOSE ... INITIALIZES COMPLEX VECTOR TO A CONSTANT VALUE 'A' C C CREATED ... APR. 14, 1987 C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER N, INCX C COMPLEX A, X (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER XADDR, I C C ================================================================== C IF ( INCX .EQ. 1 ) THEN C C ---------------------------------- C ... UNIT INCREMENT (STANDARD CASE) C ---------------------------------- C DO 100 I = 1, N X(I) = A 100 CONTINUE C ELSE C C ---------------------- C ... NON-UNIT INCREMENT C ---------------------- C XADDR = 1 IF ( INCX .LT. 0 ) THEN XADDR = (-N+1)*INCX + 1 ENDIF C DO 200 I = 1, N X (XADDR) = A XADDR = XADDR + INCX 200 CONTINUE C ENDIF C RETURN C END SUBROUTINE CAXPYI ( NZ, A, X, INDX, Y ) C C ================================================================== C ================================================================== C ==== CAXPYI -- INDEXED COMPLEX ELEMENTARY VECTOR OPERATION ==== C ================================================================== C ================================================================== C C PURPOSE C ------- C C CAXPYI ADDS A COMPLEX SCALAR MULTIPLE OF C A COMPLEX SPARSE VECTOR X C STORED IN COMPRESSED FORM (X,INDX) C TO C A COMPLEX VECTOR Y IN FULL STORAGE FORM. C C ONLY THE ELEMENTS OF Y WHOSE INDICES ARE LISTED IN INDX C ARE REFERENCED OR MODIFIED. THE VALUES IN INDX MUST BE C DISTINCT TO ALLOW CONSISTENT VECTOR OR PARALLEL EXECUTION. C C ALTHOUGH DISTINCT INDICES WILL ALLOW VECTOR OR PARALLEL C EXECUTION, MOST COMPILERS FOR HIGH-PERFORMANCE MACHINES WILL C BE UNABLE TO GENERATE BEST POSSIBLE CODE WITHOUT SOME C MODIFICATION, SUCH AS COMPILER DIRECTIVES, TO THIS CODE. C C ARGUMENTS C --------- C C INPUT ... C C NZ INTEGER NUMBER OF ELEMENTS IN THE COMPRESSED FORM. C A COMPLEX SCALAR MULTIPLIER OF X. C X COMPLEX ARRAY CONTAINING THE VALUES OF THE C COMPRESSED FORM. C INDX INTEGER ARRAY CONTAINING THE INDICES OF THE C COMPRESSED FORM. IT IS ASSUMED THAT C THE ELEMENTS IN INDX ARE DISTINCT. C C UPDATED ... C C Y COMPLEX ARRAY, ON INPUT, WHICH CONTAINS THE VECTOR C Y IN FULL STORAGE FORM. ON OUTPUT C ONLY THE ELEMENTS CORRESPONDING TO THE C INDICES IN INDX HAVE BEEN MODIFIED. C C C SPARSE BASIC LINEAR ALGEBRA SUBPROGRAM C C FORTRAN VERSION WRITTEN OCTOBER 1984 C ROGER G GRIMES, BOEING COMPUTER SERVICES C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER NZ, INDX (*) C COMPLEX Y (*), X (*), A C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER I C C ================================================================== C IF ( NZ .LE. 0 ) RETURN C IF ( A .EQ. ( 0.0E0, 0.0E0 ) ) RETURN C DO 10 I = 1, NZ Y(INDX(I)) = Y(INDX(I)) + A * X(I) 10 CONTINUE C RETURN END COMPLEX FUNCTION CDOTCI ( NZ, X, INDX, Y ) C C ================================================================== C ================================================================== C ==== CDOTCI -- COMPLEX CONJUGATED INDEXED DOT PRODUCT ==== C ================================================================== C ================================================================== C C PURPOSE C ------- C C CDOTCI COMPUTES THE CONJUGATED VECTOR INNER PRODUCT OF C A COMPLEX SPARSE VECTOR X C STORED IN COMPRESSED FORM (X,INDX) C WITH C A COMPLEX VECTOR Y IN FULL STORAGE FORM. C C ONLY THE ELEMENTS OF Y WHOSE INDICES ARE LISTED IN INDX C ARE REFERENCED. C C ARGUMENTS C --------- C C INPUT ... C C NZ INTEGER NUMBER OF ELEMENTS IN THE COMPRESSED FORM. C X COMPLEX ARRAY CONTAINING THE VALUES OF THE C COMPRESSED FORM. C INDX INTEGER ARRAY CONTAINING THE INDICES OF THE C COMPRESSED FORM. C Y COMPLEX ARRAY, ON INPUT, WHICH CONTAINS THE C VECTOR Y IN FULL STORAGE FORM. ONLY C THE ELEMENTS CORRESPONDING TO THE C INDICES IN INDX WILL BE ACCESSED. C C OUTPUT ... C C CDOTCI COMPLEX COMPLEX FUNCTION VALUE EQUAL TO THE C CONJUGATED VECTOR INNER PRODUCT. C IF NZ .LE. 0 CDOTCI IS SET TO ZERO. C C SPARSE BASIC LINEAR ALGEBRA SUBPROGRAM C C FORTRAN VERSION WRITTEN OCTOBER 1984 C ROGER G GRIMES, BOEING COMPUTER SERVICES C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER NZ, INDX (*) C COMPLEX X (*), Y (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER I C C ================================================================== C CDOTCI = ( 0.0E0, 0.0E0 ) IF ( NZ .LE. 0 ) RETURN C DO 10 I = 1, NZ CDOTCI = CDOTCI + CONJG ( X(I) ) * Y(INDX(I)) 10 CONTINUE C RETURN END COMPLEX FUNCTION CDOTUI ( NZ, X, INDX, Y ) C C ================================================================== C ================================================================== C ==== CDOTUI -- COMPLEX UNCONJUGATED INDEXED DOT PRODUCT ==== C ================================================================== C ================================================================== C C PURPOSE C ------- C C CDOTUI COMPUTES THE UNCONJUGATED VECTOR INNER PRODUCT OF C A COMPLEX SPARSE VECTOR X C STORED IN COMPRESSED FORM (X,INDX) C WITH C A COMPLEX VECTOR Y IN FULL STORAGE FORM. C C ONLY THE ELEMENTS OF Y WHOSE INDICES ARE LISTED IN INDX C ARE REFERENCED. C C ARGUMENTS C --------- C C INPUT ... C C NZ INTEGER NUMBER OF ELEMENTS IN THE COMPRESSED FORM. C X COMPLEX ARRAY CONTAINING THE VALUES OF THE C COMPRESSED FORM. C INDX INTEGER ARRAY CONTAINING THE INDICES OF THE C COMPRESSED FORM. C Y COMPLEX ARRAY, ON INPUT, WHICH CONTAINS THE C VECTOR Y IN FULL STORAGE FORM. ONLY C THE ELEMENTS CORRESPONDING TO THE C INDICES IN INDX WILL BE ACCESSED. C C OUTPUT ... C C CDOTUI COMPLEX COMPLEX FUNCTION VALUE EQUAL TO THE C UNCONJUGATED VECTOR INNER PRODUCT. C IF NZ .LE. 0 CDOTCI IS SET TO ZERO. C C SPARSE BASIC LINEAR ALGEBRA SUBPROGRAM C C FORTRAN VERSION WRITTEN OCTOBER 1984 C ROGER G GRIMES, BOEING COMPUTER SERVICES C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER NZ, INDX (*) C COMPLEX X (*), Y (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER I C C ================================================================== C CDOTUI = ( 0.0E0, 0.0E0 ) IF ( NZ .LE. 0 ) RETURN C DO 10 I = 1, NZ CDOTUI = CDOTUI + X(I) * Y(INDX(I)) 10 CONTINUE C RETURN END SUBROUTINE CGTHR ( NZ, Y, X, INDX ) C C ================================================================== C ================================================================== C ==== CGTHR -- COMPLEX GATHER ==== C ================================================================== C ================================================================== C C PURPOSE C ------- C C CGTHR GATHERS THE SPECIFIED ELEMENTS FROM C A COMPLEX VECTOR Y IN FULL STORAGE FORM C INTO C A COMPLEX VECTOR X IN COMPRESSED FORM (X,INDX). C C ONLY THE ELEMENTS OF Y WHOSE INDICES ARE LISTED IN INDX C ARE REFERENCED. C C ARGUMENTS C --------- C C INPUT ... C C NZ INTEGER NUMBER OF ELEMENTS TO BE GATHERED INTO C COMPRESSED FORM. C Y COMPLEX ARRAY, ON INPUT, WHICH CONTAINS THE C VECTOR Y IN FULL STORAGE FORM. ONLY C THE ELEMENTS CORRESPONDING TO THE INDICES C IN INDX WILL BE ACCESSED. C INDX INTEGER ARRAY CONTAINING THE INDICES OF THE VALUES C TO BE GATHERED INTO COMPRESSED FORM. C C OUTPUT ... C C X COMPLEX ARRAY CONTAINING THE VALUES GATHERED INTO C THE COMPRESSED FORM. C C SPARSE BASIC LINEAR ALGEBRA SUBPROGRAM C C FORTRAN VERSION WRITTEN OCTOBER 1984 C ROGER G GRIMES, BOEING COMPUTER SERVICES C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C C INTEGER NZ, INDX (*) C COMPLEX Y (*), X (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER I C C ================================================================== C IF ( NZ .LE. 0 ) RETURN C DO 10 I = 1, NZ X(I) = Y(INDX(I)) 10 CONTINUE C RETURN END SUBROUTINE CGTHRZ ( NZ, Y, X, INDX ) C C ================================================================== C ================================================================== C ==== CGTHRZ -- COMPLEX GATHER AND ZERO ==== C ================================================================== C ================================================================== C C PURPOSE C ------- C C CGTHRZ GATHERS THE SPECIFIED ELEMENTS FROM C A COMPLEX VECTOR Y IN FULL STORAGE FORM C INTO C A COMPLEX VECTOR X IN COMPRESSED FORM (X,INDX). C FURTHERMORE THE GATHERED ELEMENTS OF Y ARE SET TO ZERO. C C ONLY THE ELEMENTS OF Y WHOSE INDICES ARE LISTED IN INDX C ARE REFERENCED OR MODIFIED. C C ARGUMENTS C --------- C C INPUT ... C C NZ INTEGER NUMBER OF ELEMENTS TO BE GATHERED INTO C COMPRESSED FORM. C INDX INTEGER ARRAY CONTAINING THE INDICES OF THE VALUES C TO BE GATHERED INTO COMPRESSED FORM. C C UPDATED ... C C Y COMPLEX ARRAY, ON INPUT, WHICH CONTAINS THE VECTOR C Y IN FULL STORAGE FORM. THE GATHERED C COMPONENTS IN Y ARE SET TO ZERO. C ONLY THE ELEMENTS CORRESPONDING TO THE C INDICES IN INDX HAVE BEEN ACCESSED. C C OUTPUT ... C C X COMPLEX ARRAY CONTAINING THE VALUES GATHERED INTO C THE COMPRESSED FORM. C C SPARSE BASIC LINEAR ALGEBRA SUBPROGRAM C C FORTRAN VERSION WRITTEN OCTOBER 1984 C ROGER G GRIMES, BOEING COMPUTER SERVICES C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER NZ, INDX (*) C COMPLEX Y (*), X (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER I C C ================================================================== C IF ( NZ .LE. 0 ) RETURN C DO 10 I = 1, NZ X(I) = Y(INDX(I)) Y(INDX(I)) = ( 0.0E0, 0.0E0 ) 10 CONTINUE C RETURN END SUBROUTINE CSCTR ( NZ, X, INDX, Y ) C C ================================================================== C ================================================================== C ==== CSCTR -- COMPLEX SCATTER ==== C ================================================================== C ================================================================== C C PURPOSE C ------- C C CSCTR SCATTERS THE COMPONENTS OF C A SPARSE VECTOR X STORED IN COMPRESSED FORM (X,INDX) C INTO C SPECIFIED COMPONENTS OF A COMPLEX VECTOR Y C IN FULL STORAGE FORM. C C ONLY THE ELEMENTS OF Y WHOSE INDICES ARE LISTED IN INDX C ARE MODIFIED. THE VALUES IN INDX MUST BE DISTINCT TO C ALLOW CONSISTENT VECTOR OR PARALLEL EXECUTION. C C ALTHOUGH DISTINCT INDICES WILL ALLOW VECTOR OR PARALLEL C EXECUTION, MOST COMPILERS FOR HIGH-PERFORMANCE MACHINES WILL C BE UNABLE TO GENERATE BEST POSSIBLE CODE WITHOUT SOME C MODIFICATION, SUCH AS COMPILER DIRECTIVES, TO THIS CODE. C C ARGUMENTS C --------- C C INPUT ... C C NZ INTEGER NUMBER OF ELEMENTS TO BE SCATTERED FROM C COMPRESSED FORM. C X COMPLEX ARRAY CONTAINING THE VALUES TO BE C SCATTERED FROM COMPRESSED FORM INTO FULL C STORAGE FORM. C INDX INTEGER ARRAY CONTAINING THE INDICES OF THE VALUES C TO BE SCATTERED FROM COMPRESSED FORM. C IT IS ASSUMED THAT THE ELEMENTS IN INDX C ARE DISTINCT. C C OUTPUT ... C C Y COMPLEX ARRAY WHOSE ELEMENTS SPECIFIED BY INDX C HAVE BEEN SET TO THE CORRESPONDING C ENTRIES OF X. ONLY THE ELEMENTS C CORRESPONDING TO THE INDICES IN INDX C HAVE BEEN MODIFIED. C C SPARSE BASIC LINEAR ALGEBRA SUBPROGRAM C C FORTRAN VERSION WRITTEN OCTOBER 1984 C ROGER G GRIMES, BOEING COMPUTER SERVICES C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER NZ, INDX (*) C COMPLEX X (*), Y (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER I C C ================================================================== C IF ( NZ .LE. 0 ) RETURN C DO 10 I = 1, NZ Y(INDX(I)) = X(I) 10 CONTINUE C RETURN END 'CBLATS.SUMM' 6 100 5.0 16 -1 0 1 2 3 9 31 32 33 63 64 65 127 128 129 257 3 (0.0,0.0) (1.0,0.0) (0.7,0.3) PROGRAM TDSPBL C C C ================================================================== C ================================================================== C ==== TDSPBL -- CERTIFY DOUBLE PRECISION SPARSE BLAS ==== C ================================================================== C ================================================================== C C TDSPBL IS THE CERTIFICATION PROGRAM FOR THE DOUBLE PRECISION C SPARSE BLAS. THE APPROACH USED TO CERTIFY THE SPARSE BLAS C IS AS FOLLOWS: C C 1. READ IN USER SPECIFIED INPUT ON OUTPUT UNIT, THRESHOLD VALUE C FOR TEST RATIO, AND THE SPECIFICATIONS FOR NZ, A, C AND S. C 2. VERIFY THE CORRECTNESS OF THE USER SPECIFIED INPUT AND C ECHO TO THE OUTPUT UNIT. C 3. FOR EACH SUBPROGRAM IN THE DOUBLE PRECISION SPARSE BLAS C PERFORM ALL THE USER SPECIFIED TESTS AND PRINT A PASS/FAIL C MESSAGE. TESTS WHICH FAIL GENERATE ADDITIONAL OUTPUT. C C SPARSE BLAS SUBPROGRAMS WHICH ARE CERTIFIED BY THIS PROGRAM ARE C C DAXPYI DGTHR DROTI C DDOTI DGTHRZ DSCTR C C THIS PROGRAM REQUIRES AN INPUT FILE ASSIGNED TO UNIT NIN C (CURRENTLY SET TO 5 BY A PARAMETER STATEMENT). THE DATA ON C THIS INPUT FILE CONTROLS THE OUTPUT UNIT, THE THRESHOLD VALUE C FOR THE NUMERICAL TESTING, AND THE SPECIFICATIONS FOR THE C TEST VALUES FOR THE LENGTH OF THE SPARSE VECTORS AND THE SCALARS C USED BY THE VARIOUS SUBPROGRAMS. AN EXAMPLE OF THE INPUT FILE C FOLLOWS C C LINE 1 'DBLATS.SUMM' NAME OF OUTPUT FILE C LINE 2 6 UNIT NUMBER OF OUTPUT FILE C LINE 3 100 MAX. NO. OF PRINTED ERROR MESSAGES C LINE 4 5.0 THRESHOLD VALUE OF TEST RATIO C LINE 5 16 NUMBER OF VALUES OF NZ C LINE 6 -1 0 1 2 5 9 31 32 33 63 64 65 127 128 129 257 C VALUES OF NZ C LINE 7 3 NUMBER OF VALUES OF A FOR -AXPYI C LINE 8 0.0 1.0 0.7 VALUES OF A C LINE 9 4 NUMBER OF VALUES OF C,S FOR -ROTI C LINE 10 1. 0. -.6 .8 VALUES OF C C LINE 11 0. 1 .8 -.6 VALUES OF S C C C THIS INPUT FILE IS READ USING FORTRAN-77 STANDARD LIST DIRECTED C INPUT. SINGLE QUOTES ARE REQUIRED AROUND THE NAME OF THE OUTPUT C FILE ON LINE 1. THE NUMBERS ON LINES 6, 8, 10, AND 11 CAN BE C DELIMITED BY BLANKS OR COMMAS. C C THIS PROGRAM WAS WRITTEN BY ROGER G. GRIMES, BOEING C COMPUTER SERVICES, BELLEVUE, WA. DURING APRIL, 1987. C C ================================================================== C C ------------------------------------ C ... PROBLEM SPECIFICATION PARAMETERS C ------------------------------------ C C NIN INPUT UNIT C NZMAX MAXIMUM VALUE OF ANY SINGLE NZ C NNZMAX MAXIMUM NUMBER OF VALUES OF NZ C NAMAX MAXIMUM NUMBER OF VALUES OF A (-AXPYI C SCALAR) C NGMAX MAXIMUM NUMBER OF VALUES OF C AND S C (-ROTI SCALARS FOR GIVENS ROTATION) C C ================================================================== C INTEGER NIN, NZMAX, NNZMAX, NAMAX, NGMAX C PARAMETER ( NIN = 5, NZMAX = 320, 1 NNZMAX = 24, NAMAX = 7, NGMAX = 7 ) C C ----------------------- C ... COMPUTED PARAMETERS C ----------------------- C INTEGER NZMAX2 C PARAMETER ( NZMAX2 = 2 * NZMAX ) C C ================================================================== C C ------------------------ C ... VARIABLE DECLARATION C ------------------------ C CHARACTER*32 NAMOUT C INTEGER ERRCNT, ERRMAX, I, NOUT, NUMA, 1 NUMG, NUMNZ C INTEGER INDX (NZMAX2), INDXT (NZMAX2), 1 LIST (NZMAX2), NZVALU(NNZMAX) C DOUBLE PRECISION EPSILN, EPSSAV, THRESH C DOUBLE PRECISION X (NZMAX2), Y (NZMAX2), 1 XTRUE (NZMAX2), YTRUE (NZMAX2), 2 XSAVE (NZMAX2), YSAVE (NZMAX2), 3 AVALUE(NAMAX), CVALUE(NGMAX), 4 SVALUE(NGMAX) C C -------------------- C ... SUBPROGRAMS USED C -------------------- C DOUBLE PRECISION DDIFF C EXTERNAL TDXPYI, TDDOTI, TDGTHR, TDGTHZ, TDROTI, 1 TDSCTR, DDIFF C C ================================================================== C ERRCNT = 0 C C ------------------------------------------------ C ... READ IN USER SPECIFIED INPUT FOR OUTPUT UNIT C ------------------------------------------------ C READ ( NIN, * ) NAMOUT READ ( NIN, * ) NOUT C C -------------------- C ... OPEN OUTPUT UNIT C -------------------- C OPEN ( UNIT = NOUT, FILE = NAMOUT, STATUS = 'NEW' ) C C ------------------------------ C ... READ IN REMAINDER OF INPUT C ------------------------------ C READ ( NIN, * ) ERRMAX READ ( NIN, * ) THRESH READ ( NIN, * ) NUMNZ C IF ( NUMNZ .GT. NNZMAX ) THEN ERRCNT = 1 WRITE ( NOUT, 1100 ) NUMNZ, NNZMAX GO TO 900 END IF C READ ( NIN, * ) ( NZVALU(I), I = 1, NUMNZ ) C READ ( NIN, * ) NUMA C IF ( NUMA .GT. NAMAX ) THEN ERRCNT = 1 WRITE ( NOUT, 1110 ) NUMA, NAMAX GO TO 900 END IF C READ ( NIN, * ) ( AVALUE(I), I = 1, NUMA ) C READ ( NIN, * ) NUMG C IF ( NUMG .GT. NGMAX ) THEN ERRCNT = 1 WRITE ( NOUT, 1120 ) NUMG, NGMAX GO TO 900 END IF C READ ( NIN, * ) ( CVALUE(I), I = 1, NUMG ) READ ( NIN, * ) ( SVALUE(I), I = 1, NUMG ) C C ------------------------------ C ... PRINT USER SPECIFIED INPUT C ------------------------------ C WRITE ( NOUT, 1000 ) NAMOUT, NOUT, ERRMAX, THRESH WRITE ( NOUT, 1010 ) NUMNZ WRITE ( NOUT, 1020 ) ( NZVALU(I), I = 1, NUMNZ ) WRITE ( NOUT, 1030 ) NUMA WRITE ( NOUT, 1040 ) ( AVALUE(I), I = 1, NUMA ) WRITE ( NOUT, 1050 ) NUMG WRITE ( NOUT, 1060 ) ( CVALUE(I), I = 1, NUMG ) WRITE ( NOUT, 1070 ) ( SVALUE(I), I = 1, NUMG ) C C ------------------------------- C ... VERIFY USER SPECIFIED INPUT C ------------------------------- C IF ( THRESH .LE. 0.0D0 ) THEN WRITE ( NOUT, 1130 ) THRESH THRESH = 10.0D0 END IF C IF ( NUMNZ .LE. 0 ) THEN WRITE ( NOUT, 1140 ) NUMNZ ERRCNT = 1 END IF C DO 100 I = 1, NUMNZ IF ( NZVALU(I) .GT. NZMAX ) THEN WRITE ( NOUT, 1150 ) I, NZVALU(I), NZMAX NZVALU(I) = NZMAX END IF 100 CONTINUE C IF ( ERRCNT .NE. 0 ) GO TO 900 C C --------------------------- C ... COMPUTE MACHINE EPSILON C --------------------------- C EPSILN = 1.0D0 EPSSAV = 1.0D0 C 200 IF ( DDIFF ( 1.0D0 + EPSILN, 1.0D0 ) .EQ. 0.0D0 ) GO TO 210 C EPSSAV = EPSILN EPSILN = EPSILN * .5D0 GO TO 200 C 210 EPSILN = EPSSAV C C ================================================================== C C ----------------------------------------- C ... TEST THE DOUBLE PRECISION SPARSE BLAS C ----------------------------------------- C C ------------------ C ... CERTIFY DAXPYI C ------------------ C CALL TDXPYI ( NOUT, EPSILN, THRESH, NZMAX2, 1 NUMNZ, NZVALU, NUMA, AVALUE, 2 X, XSAVE, XTRUE, Y, YSAVE, YTRUE, 3 INDX, INDXT, LIST, ERRCNT, ERRMAX ) C C ----------------- C ... CERTIFY DDOTI C ----------------- C CALL TDDOTI ( NOUT, EPSILN, THRESH, NZMAX2, 1 NUMNZ, NZVALU, 2 X, XSAVE, XTRUE, Y, YSAVE, YTRUE, 3 INDX, INDXT, ERRCNT, ERRMAX ) C C ----------------- C ... CERTIFY DGTHR C ----------------- C CALL TDGTHR ( NOUT, NZMAX2, NUMNZ, NZVALU, 1 X, XSAVE, XTRUE, Y, YSAVE, YTRUE, 2 INDX, INDXT, ERRCNT, ERRMAX ) C C ------------------ C ... CERTIFY DGTHRZ C ------------------ C CALL TDGTHZ ( NOUT, NZMAX2, NUMNZ, NZVALU, 1 X, XSAVE, XTRUE, Y, YSAVE, YTRUE, 2 INDX, INDXT, ERRCNT, ERRMAX ) C C ----------------- C ... CERTIFY DROTI C ----------------- C CALL TDROTI ( NOUT, EPSILN, THRESH, NZMAX2, 1 NUMNZ, NZVALU, NUMG, CVALUE, SVALUE, 2 X, XSAVE, XTRUE, Y, YSAVE, YTRUE, 3 INDX, INDXT, LIST, ERRCNT, ERRMAX ) C C ----------------- C ... CERTIFY DSCTR C ----------------- C CALL TDSCTR ( NOUT, NZMAX2, NUMNZ, NZVALU, 1 X, XSAVE, XTRUE, Y, YSAVE, YTRUE, 2 INDX, INDXT, ERRCNT, ERRMAX ) C C ================================================================== C C ------------------------------------- C ... PRINT GLOBAL PASS OR FAIL MESSAGE C ------------------------------------- C 900 IF ( ERRCNT .EQ. 0 ) THEN WRITE ( NOUT, 2000 ) ELSE WRITE ( NOUT, 2100 ) ERRCNT END IF C C ----------------------------------------------------- C ... END OF CERTIFICATION PROGRAM FOR DOUBLE PRECISION C SPARSE BLAS C ----------------------------------------------------- C STOP C C ================================================================== C C ----------- C ... FORMATS C ----------- C 1000 FORMAT( '1' /// 1 5X, 'START OF CERTIFICATION PROGRAM FOR THE DOUBLE ', 2 'PRECISION SPARSE BLAS' 3 /5X, '----------------------------------------------', 4 '---------------------' 5 //5X, 'NAME OF OUTPUT UNIT = ', A 6 /5X, 'NUMBER OF OUTPUT UNIT = ', I10 7 /5X, 'MAX. NO. OF PRINTED ERROR MESSAGES = ', I10 8 /5X, 'THRESHOLD VALUE OF TEST RATIO = ', F10.1 ) C 1010 FORMAT ( /5X, 'NUMBER OF VALUES OF NZ = ', I10 ) C 1020 FORMAT ( /5X, 'VALUES OF NZ = ', 10I5 ) C 1030 FORMAT ( /5X, 'NUMBER OF VALUES OF A = ', I10 ) C 1040 FORMAT ( /5X, 'VALUES OF A = ', 1P, 5D13.4 ) C 1050 FORMAT ( /5X, 'NUMBER OF VALUES OF C AND S = ', I10 ) C 1060 FORMAT ( /5X, 'VALUES OF C = ', 1P, 5D13.4 ) C 1070 FORMAT ( /5X, 'VALUES OF S = ', 1P, 5D13.4 ) C 1100 FORMAT ( /5X, 'USER SPECIFIED NUMBER OF TEST CASES FOR THE ', 1 'NUMBER OF NONZEROES EXCEEDS PROGRAM LIMIT.' 2 /5X, 'NUMBER SPECIFIED = ', I10, 2X, 'PROGRAM LIMIT =', 3 I10 ) C 1110 FORMAT ( /5X, 'USER SPECIFIED NUMBER OF TEST CASES FOR THE ', 1 'SCALAR A EXCEEDS PROGRAM LIMIT.' 2 /5X, 'NUMBER SPECIFIED = ', I10, 2X, 'PROGRAM LIMIT =', 3 I10 ) C 1120 FORMAT ( /5X, 'USER SPECIFIED NUMBER OF TEST CASES FOR THE ', 1 'SCALARS C AND S EXCEEDS PROGRAM LIMIT.' 2 /5X, 'NUMBER SPECIFIED = ', I10, 2X, 'PROGRAM LIMIT =', 3 I10 ) C 1130 FORMAT ( /5X, 'USER SPECIFIED VALUE FOR THRESHOLD IS ', 1 1PD15.5, ' WHICH IS NONPOSITIVE. IT ', 2 'HAS BEEN RESET TO 10.') C 1140 FORMAT ( /5X, 'USER SPECIFIED NUMBER OF VALUES OF NZ IS ', I5, 1 ' WHICH IS NONPOSITIVE. NO TESTING WILL OCCUR.' ) C 1150 FORMAT ( /5X, 'THE ', I3, '-TH USER SPECIFIED VALUE OF NZ IS ', 1 I8, ' IS LARGER THAN THE MAXIMUM ALLOWABLE ', 2 'VALUE OF NZ. IT HAS BEEN RESET TO ', I5 ) C 2000 FORMAT ( /5X, 'DOUBLE PRECISION SPARSE BLAS HAVE PASSED ALL ', 1 'TESTS.' ) C 2100 FORMAT ( /5X, 'DOUBLE PRECISION SPARSE BLAS HAVE FAILED ', I10, 1 ' TESTS. SEE ABOVE PRINTED ERROR MESSAGES.' ) C C ================================================================== C END SUBROUTINE TDXPYI ( NOUT, EPSILN, THRESH, NZMAX2, 1 NUMNZ, NZVALU, NUMA, AVALUE, 2 X, XSAVE, XTRUE, Y, YSAVE, 3 YTRUE , INDX, INDXT, LIST, ERRCNT, 4 ERRMAX ) C C ================================================================== C ================================================================== C ==== TDXPYI -- CERTIFY DAXPYI ==== C ================================================================== C ================================================================== C C SUBROUTINE TDXPYI IS THE CERTIFICATION MODULE FOR THE SPARSE C BASIC LINEAR ALGEBRA SUBROUTINE MODULE DAXPYI. C C WRITTEN BY ROGER G GRIMES C APRIL 1987 C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER NOUT, NZMAX2, NUMNZ, NUMA, ERRCNT, 1 ERRMAX C INTEGER NZVALU (*), INDX (*), INDXT (*), 1 LIST (*) C DOUBLE PRECISION EPSILN, THRESH C DOUBLE PRECISION AVALUE (*), 1 X (*), XSAVE (*), XTRUE (*), 2 Y (*), YSAVE (*), YTRUE (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C DOUBLE PRECISION A, ATRUE, CLOBBR C INTEGER COUNT, I, ICLOBR, J, KA, 1 KINDX, KNZ, N, NZ, NZTRUE C DOUBLE PRECISION ERR, S, T C C -------------------- C ... SUBPROGRAMS USED C -------------------- C LOGICAL IVSAME, DVSAME C EXTERNAL ICOPY, DCOPY, IINIT, DINIT, GNINDX, 1 IVSAME, DVSAME, DAXPYI C C ================================================================== C C ------------------ C ... INITIALIZATION C ------------------ C COUNT = 0 C CLOBBR = -1.0D10 ICLOBR = -10000000 C C ------------------------------------ C ... GENERATE SOME VALUES FOR X AND Y C ------------------------------------ C DO 100 I = 1, NZMAX2 XSAVE(I) = COS ( .6*DBLE(I) ) YSAVE(I) = SIN ( .7*DBLE(I) ) 100 CONTINUE C C ------------------------ C ... FOR EACH VALUE OF NZ C ------------------------ C DO 700 KNZ = 1, NUMNZ C NZTRUE = NZVALU(KNZ) N = 2 * MAX ( NZTRUE, 1 ) C C ----------------------- C ... FOR EACH VALUE OF A C ----------------------- C DO 600 KA = 1, NUMA C ATRUE = AVALUE(KA) C C ------------------------------- C ... FOR EACH KIND OF INDX ARRAY C ------------------------------- C DO 500 KINDX = 1, 5 C CALL GNINDX ( NZTRUE, N, ICLOBR, KINDX, INDXT ) C CALL IINIT ( N, -1, LIST, 1 ) C DO 150 I = 1, NZTRUE LIST (INDXT(I)) = I 150 CONTINUE C C ----------------------- C ... GENERATE INPUT DATA C ----------------------- C I = MIN ( N, N-NZTRUE ) J = N - I + 1 CALL DCOPY ( NZTRUE, XSAVE, 1, XTRUE, 1 ) CALL DINIT ( I, CLOBBR, XTRUE(J), 1 ) CALL DINIT ( N, CLOBBR, YTRUE, 1 ) C DO 200 I = 1, NZTRUE YTRUE (INDXT(I)) = YSAVE (INDXT(I)) 200 CONTINUE C C ------------------- C ... COPY TRUE INPUT C ------------------- C A = ATRUE NZ = NZTRUE C CALL DCOPY ( N, YTRUE, 1, Y, 1 ) CALL DCOPY ( N, XTRUE, 1, X, 1 ) CALL ICOPY ( N, INDXT, 1, INDX, 1 ) C C -------------------------- C ... COMPUTE IN-LINE RESULT C -------------------------- C DO 300 I = 1, NZTRUE YTRUE (INDXT(I)) = YTRUE (INDXT(I)) + 1 ATRUE * XTRUE(I) 300 CONTINUE C C --------------- C ... CALL DAXPYI C --------------- C CALL DAXPYI ( NZ, A, X, INDX, Y ) C C ----------------------------------------- C ... TEST ARGUMENTS OF DAXPYI THAT ARE NOT C SUPPOSED TO CHANGE. C ----------------------------------------- C IF ( NZ .NE. NZTRUE ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1000 ) NZTRUE, ATRUE, KINDX, 1 NZ END IF END IF C IF ( A .NE. ATRUE ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1100 ) NZTRUE, ATRUE, KINDX, 1 A END IF END IF C IF ( .NOT. DVSAME ( N, X, XTRUE ) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1200 ) NZTRUE, ATRUE, KINDX END IF END IF C IF ( .NOT. IVSAME ( N, INDX, INDXT ) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1300 ) NZTRUE, ATRUE, KINDX END IF END IF C C --------------------------- C ... TEST OUTPUT FROM DAXPYI C --------------------------- C DO 400 J = 1, N IF ( LIST(J) .EQ. -1 ) THEN IF ( Y(J) .NE. YTRUE(J) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1400 ) NZTRUE, ATRUE, 1 KINDX, J, 2 Y(J), YTRUE(J) END IF END IF C ELSE C S = ABS ( Y(J) - YTRUE(J) ) T = ABS ( ATRUE) * ABS ( XTRUE (LIST(J))) + 1 ABS ( YSAVE(J)) ERR = S / ( EPSILN * T ) IF ( ERR .GT. THRESH ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1500 ) NZTRUE, ATRUE, 1 KINDX, J, Y(J), 2 YTRUE(J), ERR END IF END IF C END IF C 400 CONTINUE C 500 CONTINUE C 600 CONTINUE C 700 CONTINUE C C ================================================================== C C ------------------ C ... END OF TESTING C ------------------ C ERRCNT = ERRCNT + COUNT IF ( COUNT .NE. 0 ) GO TO 800 C C ----------------------------------- C ... WRITE PASSED MESSAGE AND RETURN C ----------------------------------- C WRITE ( NOUT, 2700 ) GO TO 900 C C ----------------------------------- C ... WRITE FAILED MESSAGE AND RETURN C ----------------------------------- C 800 WRITE ( NOUT, 2800 ) COUNT C C ------------------------ C ... END OF MODULE TDXPYI C ------------------------ C 900 CONTINUE RETURN C C ================================================================== C C ----------- C ... FORMATS C ----------- C 1000 FORMAT ( 5X, 'DAXPYI ALTERED NZ FOR TEST WITH NZ = ', I5, 1 ' A =', 1PD15.5, 2 ' AND THE INDX TYPE NO. ', I5, 3 '. ALTERED VALUE OF NZ = ', I5 ) C 1100 FORMAT ( 5X, 'DAXPYI ALTERED A FOR TEST WITH NZ = ', I5, 1 ' A =', 1PD15.5, 2 ' AND THE INDX TYPE NO. ', I5, 3 '. ALTERED VALUE OF A =', 1PD15.5 ) C 1200 FORMAT ( 5X, 'DAXPYI ALTERED ARRAY X FOR TEST WITH NZ = ', I5, 1 ' A =', 1PD15.5, 2 ' AND THE INDX TYPE NO. ', I5 ) C 1300 FORMAT ( 5X, 'DAXPYI ALTERED ARRAY INDX FOR TEST WITH NZ = ', I5, 1 ' A =', 1PD15.5, 2 ' AND THE INDX TYPE NO. ', I5 ) C 1400 FORMAT ( 5X, 'DAXPYI OUTPUT ARRAY Y IS INCORRECT FOR TEST WITH ', 1 'NZ = ', I5, ' A =', 1PD15.5, 2 ' AND THE INDX TYPE NO. ', I5 3 /5X, 'INCORRECT COMPONENT NO. ', I5, ' HAS VALUE =', 4 1PD15.5, 5 ' TRUE VALUE =', 1PD15.5 ) C 1500 FORMAT ( 5X, 'DAXPYI OUTPUT ARRAY Y IS INACCURATE FOR TEST WITH ', 1 'NZ = ', I5, ' A =', 1PD15.5, 2 ' AND THE INDX TYPE NO. ', I5 3 /5X, 'INACCURATE COMPONENT NO. ', I5, ' HAS VALUE =', 4 1PD15.5, ' TRUE VALUE =', 5 1PD15.5, ' ERROR = ', 1PD12.1 ) C 2700 FORMAT ( /5X, 'DAXPYI PASSED ALL TESTS.' ) C 2800 FORMAT ( /5X, 'DAXPYI FAILED', I10, ' TESTS.' ) C C ================================================================== C END SUBROUTINE TDDOTI ( NOUT, EPSILN, THRESH, NZMAX2, 1 NUMNZ, NZVALU, 2 X, XSAVE, XTRUE, Y, YSAVE, 3 YTRUE , INDX, INDXT, ERRCNT, ERRMAX ) C C ================================================================== C ================================================================== C ==== TDDOTI -- CERTIFY DDOTI ==== C ================================================================== C ================================================================== C C SUBROUTINE TDDOTI IS THE CERTIFICATION MODULE FOR THE SPARSE C BASIC LINEAR ALGEBRA SUBROUTINE MODULE DDOTI. C C WRITTEN BY ROGER G GRIMES C APRIL 1987 C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER NOUT, NZMAX2, NUMNZ, ERRCNT, 1 ERRMAX C INTEGER NZVALU (*), INDX (*), INDXT (*) C DOUBLE PRECISION EPSILN, THRESH C DOUBLE PRECISION X (*), XSAVE (*), XTRUE (*), 1 Y (*), YSAVE (*), YTRUE (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER COUNT, I, ICLOBR, J, KINDX, 1 KNZ, N, NZ, NZTRUE C DOUBLE PRECISION ERR, S, T C DOUBLE PRECISION CLOBBR, V, W C C -------------------- C ... SUBPROGRAMS USED C -------------------- C LOGICAL IVSAME, DVSAME C DOUBLE PRECISION DDOTI C EXTERNAL ICOPY, DCOPY, DINIT, GNINDX, 1 IVSAME, DVSAME, DDOTI C C ================================================================== C C ------------------ C ... INITIALIZATION C ------------------ C COUNT = 0 C CLOBBR = -1.0D10 ICLOBR = -10000000 C C ------------------------------------ C ... GENERATE SOME VALUES FOR X AND Y C ------------------------------------ C DO 100 I = 1, NZMAX2 XSAVE(I) = COS ( .6*DBLE(I) ) YSAVE(I) = SIN ( .7*DBLE(I) ) 100 CONTINUE C C ------------------------ C ... FOR EACH VALUE OF NZ C ------------------------ C DO 600 KNZ = 1, NUMNZ C NZTRUE = NZVALU(KNZ) N = 2 * MAX ( NZTRUE, 1 ) C C ------------------------------- C ... FOR EACH KIND OF INDX ARRAY C ------------------------------- C DO 500 KINDX = 1, 5 C CALL GNINDX ( NZTRUE, N, ICLOBR, KINDX, INDXT ) C C ----------------------- C ... GENERATE INPUT DATA C ----------------------- C I = MIN ( N, N-NZTRUE ) J = N - I + 1 CALL DCOPY ( NZTRUE, XSAVE, 1, XTRUE, 1 ) CALL DINIT ( I, CLOBBR, XTRUE(J), 1 ) CALL DINIT ( N, CLOBBR, YTRUE, 1 ) C DO 200 I = 1, NZTRUE YTRUE (INDXT(I)) = YSAVE (INDXT(I)) 200 CONTINUE C C ------------------- C ... COPY TRUE INPUT C ------------------- C NZ = NZTRUE C CALL DCOPY ( N, YTRUE, 1, Y, 1 ) CALL DCOPY ( N, XTRUE, 1, X, 1 ) CALL ICOPY ( N, INDXT, 1, INDX, 1 ) C C -------------------------- C ... COMPUTE IN-LINE RESULT C -------------------------- C V = 0.0D0 C DO 300 I = 1, NZTRUE V = V + XTRUE(I) * YTRUE (INDXT(I)) 300 CONTINUE C C -------------- C ... CALL DDOTI C -------------- C W = DDOTI ( NZ, X, INDX, Y ) C C ---------------------------------------- C ... TEST ARGUMENTS OF DDOTI THAT ARE NOT C SUPPOSED TO CHANGE. C ---------------------------------------- C IF ( NZ .NE. NZTRUE ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1000 ) NZTRUE, KINDX, NZ END IF END IF C IF ( .NOT. DVSAME ( N, X, XTRUE ) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1100 ) NZTRUE, KINDX END IF END IF C IF ( .NOT. IVSAME ( N, INDX, INDXT ) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1200 ) NZTRUE, KINDX END IF END IF C IF ( .NOT. DVSAME ( N, Y, YTRUE ) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1300 ) NZTRUE, KINDX END IF END IF C C -------------------------- C ... TEST OUTPUT FROM DDOTI C -------------------------- C S = ABS ( V - W ) C T = 0.0D0 DO 400 I = 1, NZTRUE T = T + ABS ( XTRUE(I) * YTRUE (INDXT(I)) ) 400 CONTINUE C IF ( T .EQ. 0.0D0 ) T = 1.0D0 C ERR = S / ( EPSILN * T ) C IF ( ERR .GT. THRESH ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1400 ) NZTRUE, KINDX, 1 W, V, ERR END IF END IF C 500 CONTINUE C 600 CONTINUE C C ================================================================== C C ------------------ C ... END OF TESTING C ------------------ C ERRCNT = ERRCNT + COUNT IF ( COUNT .NE. 0 ) GO TO 800 C C ----------------------------------- C ... WRITE PASSED MESSAGE AND RETURN C ----------------------------------- C WRITE ( NOUT, 2700 ) GO TO 900 C C ----------------------------------- C ... WRITE FAILED MESSAGE AND RETURN C ----------------------------------- C 800 WRITE ( NOUT, 2800 ) COUNT C C ------------------------ C ... END OF MODULE TDDOTI C ------------------------ C 900 CONTINUE RETURN C C ================================================================== C C ----------- C ... FORMATS C ----------- C 1000 FORMAT ( 5X, 'DDOTI ALTERED NZ FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5, 2 '. ALTERED VALUE OF NZ = ', I5 ) C 1100 FORMAT ( 5X, 'DDOTI ALTERED ARRAY X FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5 ) C 1200 FORMAT ( 5X, 'DDOTI ALTERED ARRAY INDX FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5 ) C 1300 FORMAT ( 5X, 'DDOTI ALTERED ARRAY Y FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5 ) C 1400 FORMAT ( 5X, 'DDOTI OUTPUT W IS INACCURATE FOR TEST WITH ', 1 'NZ = ', I5, ' AND THE INDX TYPE NO. ', I5 2 /5X, 'DDOTI HAS VALUE =', 1PD15.5, 3 ' TRUE VALUE =', 1PD15.5, 4 ' ERROR = ', 1PD12.1 ) C 2700 FORMAT ( /5X, 'DDOTI PASSED ALL TESTS.' ) C 2800 FORMAT ( /5X, 'DDOTI FAILED', I10, ' TESTS.' ) C C ================================================================== C END SUBROUTINE TDGTHR ( NOUT, NZMAX2, NUMNZ, NZVALU, 1 X, XSAVE, XTRUE, Y, YSAVE, 2 YTRUE , INDX, INDXT, ERRCNT, ERRMAX ) C C ================================================================== C ================================================================== C ==== TDGTHR -- CERTIFY DGTHR ==== C ================================================================== C ================================================================== C C SUBROUTINE TDGTHR IS THE CERTIFICATION MODULE FOR THE SPARSE C BASIC LINEAR ALGEBRA SUBROUTINE MODULE DGTHR. C C WRITTEN BY ROGER G GRIMES C APRIL 1987 C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER NOUT, NZMAX2, NUMNZ, ERRCNT, 1 ERRMAX C INTEGER NZVALU (*), INDX (*), INDXT (*) C DOUBLE PRECISION X (*), XSAVE (*), XTRUE (*), 1 Y (*), YSAVE (*), YTRUE (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER COUNT, I, ICLOBR, KINDX, 1 KNZ, N, NZ, NZTRUE C DOUBLE PRECISION CLOBBR C C -------------------- C ... SUBPROGRAMS USED C -------------------- C LOGICAL IVSAME, DVSAME C EXTERNAL ICOPY, DCOPY, DINIT, GNINDX, 1 IVSAME, DVSAME, DGTHR C C ================================================================== C C ------------------ C ... INITIALIZATION C ------------------ C COUNT = 0 C CLOBBR = -1.0D10 ICLOBR = -10000000 C C ------------------------------------ C ... GENERATE SOME VALUES FOR X AND Y C ------------------------------------ C DO 100 I = 1, NZMAX2 XSAVE(I) = COS ( .6*DBLE(I) ) YSAVE(I) = SIN ( .7*DBLE(I) ) 100 CONTINUE C C ------------------------ C ... FOR EACH VALUE OF NZ C ------------------------ C DO 600 KNZ = 1, NUMNZ C NZTRUE = NZVALU(KNZ) N = 2 * MAX ( NZTRUE, 1 ) C C ------------------------------- C ... FOR EACH KIND OF INDX ARRAY C ------------------------------- C DO 500 KINDX = 1, 5 C CALL GNINDX ( NZTRUE, N, ICLOBR, KINDX, INDXT ) C C ----------------------- C ... GENERATE INPUT DATA C ----------------------- C CALL DINIT ( N, CLOBBR, XTRUE, 1 ) CALL DINIT ( N, CLOBBR, YTRUE, 1 ) C DO 200 I = 1, NZTRUE YTRUE (INDXT(I)) = YSAVE (INDXT(I)) 200 CONTINUE C C ------------------- C ... COPY TRUE INPUT C ------------------- C NZ = NZTRUE C CALL DCOPY ( N, YTRUE, 1, Y, 1 ) CALL DCOPY ( N, XTRUE, 1, X, 1 ) CALL ICOPY ( N, INDXT, 1, INDX, 1 ) C C -------------------------- C ... COMPUTE IN-LINE RESULT C -------------------------- C DO 300 I = 1, NZTRUE XTRUE (I) = YTRUE (INDXT(I)) 300 CONTINUE C C -------------- C ... CALL DGTHR C -------------- C CALL DGTHR ( NZ, Y, X, INDX ) C C ---------------------------------------- C ... TEST ARGUMENTS OF DGTHR THAT ARE NOT C SUPPOSED TO CHANGE. C ---------------------------------------- C IF ( NZ .NE. NZTRUE ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1000 ) NZTRUE, KINDX, NZ END IF END IF C IF ( .NOT. DVSAME ( N, Y, YTRUE ) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1100 ) NZTRUE, KINDX END IF END IF C IF ( .NOT. IVSAME ( N, INDX, INDXT ) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1200 ) NZTRUE, KINDX END IF END IF C C -------------------------- C ... TEST OUTPUT FROM DGTHR C -------------------------- C DO 400 I = 1, N IF ( X(I) .NE. XTRUE(I) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1300 ) NZTRUE, KINDX, I, 1 X(I), XTRUE(I) END IF END IF 400 CONTINUE C 500 CONTINUE C 600 CONTINUE C C ================================================================== C C ------------------ C ... END OF TESTING C ------------------ C ERRCNT = ERRCNT + COUNT IF ( COUNT .NE. 0 ) GO TO 800 C C ----------------------------------- C ... WRITE PASSED MESSAGE AND RETURN C ----------------------------------- C WRITE ( NOUT, 2700 ) GO TO 900 C C ----------------------------------- C ... WRITE FAILED MESSAGE AND RETURN C ----------------------------------- C 800 WRITE ( NOUT, 2800 ) COUNT C C ------------------------ C ... END OF MODULE TDGTHR C ------------------------ C 900 CONTINUE RETURN C C ================================================================== C C ----------- C ... FORMATS C ----------- C 1000 FORMAT ( 5X, 'DGTHR ALTERED NZ FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5, 2 '. ALTERED VALUE OF NZ = ', I5 ) C 1100 FORMAT ( 5X, 'DGTHR ALTERED ARRAY Y FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5 ) C 1200 FORMAT ( 5X, 'DGTHR ALTERED ARRAY INDX FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5 ) C 1300 FORMAT ( 5X, 'DGTHR OUTPUT ARRAY X IS INCORRECT FOR TEST WITH ', 1 'NZ = ', I5, ' AND THE INDX TYPE NO. ', I5 2 /5X, 'INACCURATE COMPONENT NO. ', I5, ' HAS VALUE =', 3 1PD15.5, ' TRUE VALUE = ', 1PD15.5 ) C 2700 FORMAT ( /5X, 'DGTHR PASSED ALL TESTS.' ) C 2800 FORMAT ( /5X, 'DGTHR FAILED', I10, ' TESTS.' ) C C ================================================================== C END SUBROUTINE TDGTHZ ( NOUT, NZMAX2, NUMNZ, NZVALU, 1 X, XSAVE, XTRUE, Y, YSAVE, 2 YTRUE , INDX, INDXT, ERRCNT, ERRMAX ) C C ================================================================== C ================================================================== C ==== TDGTHZ -- CERTIFY DGTHRZ ==== C ================================================================== C ================================================================== C C SUBROUTINE TDGTHZ IS THE CERTIFICATION MODULE FOR THE SPARSE C BASIC LINEAR ALGEBRA SUBROUTINE MODULE DGTHRZ. C C WRITTEN BY ROGER G GRIMES C APRIL 1987 C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER NOUT, NZMAX2, NUMNZ, ERRCNT, 1 ERRMAX C INTEGER NZVALU (*), INDX (*), INDXT (*) C DOUBLE PRECISION X (*), XSAVE (*), XTRUE (*), 1 Y (*), YSAVE (*), YTRUE (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER COUNT, I, ICLOBR, KINDX, 1 KNZ, N, NZ, NZTRUE C DOUBLE PRECISION CLOBBR C C -------------------- C ... SUBPROGRAMS USED C -------------------- C LOGICAL IVSAME, DVSAME C EXTERNAL ICOPY, DCOPY, DINIT, GNINDX, 1 IVSAME, DVSAME, DGTHRZ C C ================================================================== C C ------------------ C ... INITIALIZATION C ------------------ C COUNT = 0 C CLOBBR = -1.0D10 ICLOBR = -10000000 C C ------------------------------------ C ... GENERATE SOME VALUES FOR X AND Y C ------------------------------------ C DO 100 I = 1, NZMAX2 XSAVE(I) = COS ( .6*DBLE(I) ) YSAVE(I) = SIN ( .7*DBLE(I) ) 100 CONTINUE C C ------------------------ C ... FOR EACH VALUE OF NZ C ------------------------ C DO 600 KNZ = 1, NUMNZ C NZTRUE = NZVALU(KNZ) N = 2 * MAX ( NZTRUE, 1 ) C C ------------------------------- C ... FOR EACH KIND OF INDX ARRAY C ------------------------------- C DO 500 KINDX = 1, 5 C CALL GNINDX ( NZTRUE, N, ICLOBR, KINDX, INDXT ) C C ----------------------- C ... GENERATE INPUT DATA C ----------------------- C CALL DINIT ( N, CLOBBR, XTRUE, 1 ) CALL DINIT ( N, CLOBBR, YTRUE, 1 ) C DO 200 I = 1, NZTRUE YTRUE (INDXT(I)) = YSAVE (INDXT(I)) 200 CONTINUE C C ------------------- C ... COPY TRUE INPUT C ------------------- C NZ = NZTRUE C CALL DCOPY ( N, YTRUE, 1, Y, 1 ) CALL DCOPY ( N, XTRUE, 1, X, 1 ) CALL ICOPY ( N, INDXT, 1, INDX, 1 ) C C -------------------------- C ... COMPUTE IN-LINE RESULT C -------------------------- C DO 300 I = 1, NZTRUE XTRUE (I) = YTRUE (INDXT(I)) YTRUE(INDXT(I)) = 0.0D0 300 CONTINUE C C --------------- C ... CALL DGTHRZ C --------------- C CALL DGTHRZ ( NZ, Y, X, INDX ) C C ----------------------------------------- C ... TEST ARGUMENTS OF DGTHRZ THAT ARE NOT C SUPPOSED TO CHANGE. C ----------------------------------------- C IF ( NZ .NE. NZTRUE ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1000 ) NZTRUE, KINDX, NZ END IF END IF C IF ( .NOT. IVSAME ( N, INDX, INDXT ) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1100 ) NZTRUE, KINDX END IF END IF C C --------------------------- C ... TEST OUTPUT FROM DGTHRZ C --------------------------- C DO 400 I = 1, N C IF ( X(I) .NE. XTRUE(I) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1200 ) NZTRUE, KINDX, I, 1 X(I), XTRUE(I) END IF END IF C IF ( Y(I) .NE. YTRUE(I) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1300 ) NZTRUE, KINDX, I, 1 Y(I), YTRUE(I) END IF END IF C 400 CONTINUE C 500 CONTINUE C 600 CONTINUE C C ================================================================== C C ------------------ C ... END OF TESTING C ------------------ C ERRCNT = ERRCNT + COUNT IF ( COUNT .NE. 0 ) GO TO 800 C C ----------------------------------- C ... WRITE PASSED MESSAGE AND RETURN C ----------------------------------- C WRITE ( NOUT, 2700 ) GO TO 900 C C ----------------------------------- C ... WRITE FAILED MESSAGE AND RETURN C ----------------------------------- C 800 WRITE ( NOUT, 2800 ) COUNT C C ------------------------ C ... END OF MODULE TDGTHZ C ------------------------ C 900 CONTINUE RETURN C C ================================================================== C C ----------- C ... FORMATS C ----------- C 1000 FORMAT ( 5X, 'DGTHRZ ALTERED NZ FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5, 2 '. ALTERED VALUE OF NZ = ', I5 ) C 1100 FORMAT ( 5X, 'DGTHRZ ALTERED ARRAY INDX FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5 ) C 1200 FORMAT ( 5X, 'DGTHRZ OUTPUT ARRAY X IS INCORRECT FOR TEST WITH ', 1 'NZ = ', I5, ' AND THE INDX TYPE NO. ', I5 2 /5X, 'INACCURATE COMPONENT NO. ', I5, ' HAS VALUE =', 3 1PD15.5, ' TRUE VALUE =', 1PD15.5 ) C 1300 FORMAT ( 5X, 'DGTHRZ OUTPUT ARRAY Y IS INCORRECT FOR TEST WITH ', 1 'NZ = ', I5, ' AND THE INDX TYPE NO. ', I5 2 /5X, 'INACCURATE COMPONENT NO. ', I5, ' HAS VALUE =', 3 1PD15.5, ' TRUE VALUE =', 1PD15.5 ) C 2700 FORMAT ( /5X, 'DGTHRZ PASSED ALL TESTS.' ) C 2800 FORMAT ( /5X, 'DGTHRZ FAILED', I10, ' TESTS.' ) C C ================================================================== C END SUBROUTINE TDROTI ( NOUT, EPSILN, THRESH, NZMAX2, 1 NUMNZ, NZVALU, NUMG, CVALUE, SVALUE, 2 X, XSAVE, XTRUE, Y, YSAVE, 3 YTRUE , INDX, INDXT, LIST, ERRCNT, 4 ERRMAX ) C C ================================================================== C ================================================================== C ==== TDROTI -- CERTIFY DROTI ==== C ================================================================== C ================================================================== C C SUBROUTINE TDROTI IS THE CERTIFICATION MODULE FOR THE SPARSE C BASIC LINEAR ALGEBRA SUBROUTINE MODULE DROTI. C C WRITTEN BY ROGER G GRIMES C APRIL 1987 C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER NOUT, NZMAX2, NUMNZ, NUMG, ERRCNT, 1 ERRMAX C INTEGER NZVALU (*), INDX (*), INDXT (*), 1 LIST (*) C DOUBLE PRECISION EPSILN, THRESH C DOUBLE PRECISION CVALUE (*), SVALUE (*), 1 X (*), XSAVE (*), XTRUE (*), 2 Y (*), YSAVE (*), YTRUE (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER COUNT, I, ICLOBR, J, KG, 1 KINDX, KNZ, N, NZ, NZTRUE C DOUBLE PRECISION C, CLOBBR, CTRUE, ERR, S, 1 STRUE, V, W C C -------------------- C ... SUBPROGRAMS USED C -------------------- C LOGICAL IVSAME C EXTERNAL DCOPY, DINIT, ICOPY, IINIT, GNINDX, 1 IVSAME, DROTI C C ================================================================== C C ------------------ C ... INITIALIZATION C ------------------ C COUNT = 0 C CLOBBR = -1.0D10 ICLOBR = -10000000 C C ------------------------------------ C ... GENERATE SOME VALUES FOR X AND Y C ------------------------------------ C DO 100 I = 1, NZMAX2 XSAVE(I) = COS ( .6D0 * DBLE(I) ) YSAVE(I) = SIN ( .7D0 * DBLE(I) ) 100 CONTINUE C C ------------------------ C ... FOR EACH VALUE OF NZ C ------------------------ C DO 700 KNZ = 1, NUMNZ C NZTRUE = NZVALU(KNZ) N = 2 * MAX ( NZTRUE, 1 ) C C ----------------------------- C ... FOR EACH VALUE OF C AND S C ----------------------------- C DO 600 KG = 1, NUMG C CTRUE = CVALUE(KG) STRUE = SVALUE(KG) C C ------------------------------- C ... FOR EACH KIND OF INDX ARRAY C ------------------------------- C DO 500 KINDX = 1, 5 C CALL GNINDX ( NZTRUE, N, ICLOBR, KINDX, INDXT ) C CALL IINIT ( N, -1, LIST, 1 ) C DO 150 I = 1, NZTRUE LIST (INDXT(I)) = I 150 CONTINUE C C ----------------------- C ... GENERATE INPUT DATA C ----------------------- C I = MIN ( N, N-NZTRUE ) J = N - I + 1 CALL DCOPY ( NZTRUE, XSAVE, 1, XTRUE, 1 ) CALL DINIT ( I, CLOBBR, XTRUE(J), 1 ) CALL DINIT ( N, CLOBBR, YTRUE , 1 ) C DO 200 I = 1, NZTRUE YTRUE (INDXT(I)) = YSAVE (INDXT(I)) 200 CONTINUE C C ------------------- C ... COPY TRUE INPUT C ------------------- C C = CTRUE S = STRUE NZ = NZTRUE C CALL DCOPY ( N, YTRUE, 1, Y, 1 ) CALL DCOPY ( N, XTRUE, 1, X, 1 ) CALL ICOPY ( N, INDXT, 1, INDX, 1 ) C C -------------------------- C ... COMPUTE IN-LINE RESULT C -------------------------- C DO 300 I = 1, NZTRUE V = XTRUE(I) XTRUE(I) = CTRUE * V + 1 STRUE * YTRUE (INDXT(I)) YTRUE (INDXT(I)) = -STRUE * V + 1 CTRUE * YTRUE (INDXT(I)) 300 CONTINUE C C -------------- C ... CALL DROTI C -------------- C CALL DROTI ( NZ, X, INDX, Y, C, S ) C C ---------------------------------------- C ... TEST ARGUMENTS OF DROTI THAT ARE NOT C SUPPOSED TO CHANGE. C ---------------------------------------- C IF ( NZ .NE. NZTRUE ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1000 ) NZTRUE, CTRUE, STRUE, 1 KINDX, NZ END IF END IF C IF ( C .NE. CTRUE ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1100 ) NZTRUE, CTRUE, STRUE, 1 KINDX, C, S END IF END IF C IF ( S .NE. STRUE ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1200 ) NZTRUE, CTRUE, STRUE, 1 KINDX, C, S END IF END IF C IF ( .NOT. IVSAME ( N, INDX, INDXT ) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1300 ) NZTRUE, CTRUE, STRUE, 1 KINDX END IF END IF C C -------------------------- C ... TEST OUTPUT FROM DROTI C -------------------------- C DO 400 J = 1, N C IF ( LIST(J) .EQ. -1 ) THEN C IF ( X(J) .NE. XTRUE(J) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1400 ) NZTRUE, CTRUE, 1 STRUE, KINDX, J, 2 X(J), XTRUE(J) END IF END IF C IF ( Y(J) .NE. YTRUE(J) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1500 ) NZTRUE, CTRUE, 1 STRUE, KINDX, J, 2 Y(J), YTRUE(J) END IF END IF C ELSE C V = ABS ( X (LIST(J)) - XTRUE (LIST(J)) ) W = ABS ( CTRUE ) * ABS ( XSAVE (LIST(J)) ) + 1 ABS ( STRUE ) * ABS ( YSAVE(J) ) IF ( W .EQ. 0.0D0 ) W = 1.0D0 ERR = V / ( EPSILN * W ) IF ( ERR .GT. THRESH ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1600 ) NZTRUE, CTRUE, 1 STRUE, KINDX, I, 2 X (LIST(J)), 3 XTRUE (LIST(J)), 4 ERR END IF END IF C V = ABS ( Y(J) - YTRUE(J) ) W = ABS ( STRUE ) * ABS ( XSAVE (LIST(J)) ) + 1 ABS ( CTRUE ) * ABS ( YSAVE(J) ) IF ( W .EQ. 0.0D0 ) W = 1.0D0 ERR = V / ( EPSILN * W ) IF ( ERR .GT. THRESH ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1700 ) NZTRUE, CTRUE, 1 STRUE, KINDX, J, 2 Y(J), YTRUE(J), 3 ERR END IF END IF C END IF C 400 CONTINUE C 500 CONTINUE C 600 CONTINUE C 700 CONTINUE C C ================================================================== C C ------------------ C ... END OF TESTING C ------------------ C ERRCNT = ERRCNT + COUNT IF ( COUNT .NE. 0 ) GO TO 800 C C ----------------------------------- C ... WRITE PASSED MESSAGE AND RETURN C ----------------------------------- C WRITE ( NOUT, 2700 ) GO TO 900 C C ----------------------------------- C ... WRITE FAILED MESSAGE AND RETURN C ----------------------------------- C 800 WRITE ( NOUT, 2800 ) COUNT C C ------------------------ C ... END OF MODULE TDROTI C ------------------------ C 900 CONTINUE RETURN C C ================================================================== C C ----------- C ... FORMATS C ----------- C 1000 FORMAT ( 5X, 'DROTI ALTERED NZ FOR TEST WITH NZ = ', I5, 1 ' C, S = ', 1P, 2D15.5, ' AND THE INDX TYPE NO. ', I5 2 /5X, 'ALTERED VALUE OF NZ = ', I5 ) C 1100 FORMAT ( 5X, 'DROTI ALTERED C FOR TEST WITH NZ = ', I5, 1 ' C, S = ', 1P, 2D15.5, ' AND THE INDX TYPE NO. ', I5 2 /5X, 'ALTERED VALUE OF C = ', 1PD15.5 ) C 1200 FORMAT ( 5X, 'DROTI ALTERED S FOR TEST WITH NZ = ', I5, 1 ' C, S = ', 1P, 2D15.5, ' AND THE INDX TYPE NO. ', I5 2 /5X, 'ALTERED VALUE OF S = ', 1PD15.5 ) C 1300 FORMAT ( 5X, 'DROTI ALTERED ARRAY INDX FOR TEST WITH NZ = ', I5, 1 ' C, S = ', 1P, 2D15.5, ' AND THE INDX TYPE NO. ', 2 I5 ) C 1400 FORMAT ( 5X, 'DROTI OUTPUT ARRAY X IS INCORRECT FOR TEST WITH ', 1 'NZ = ', I5, ' C, S = ', 1P, 2D15.5, 2 ' AND THE INDX TYPE NO. ', I5 3 /5X, 'INCORRECT COMPONENT NO. ', I5, ' HAS VALUE = ', 4 1PD15.5, ' TRUE VALUE = ', 1PD15.5 ) C 1500 FORMAT ( 5X, 'DROTI OUTPUT ARRAY Y IS INCORRECT FOR TEST WITH ', 1 'NZ = ', I5, ' C, S = ', 1P, 2D15.5, 2 ' AND THE INDX TYPE NO. ', I5 3 /5X, 'INCORRECT COMPONENT NO. ', I5, ' HAS VALUE = ', 4 1PD15.5, ' TRUE VALUE = ', 1PD15.5 ) C 1600 FORMAT ( 5X, 'DROTI OUTPUT ARRAY X IS INACCURATE FOR TEST WITH ', 1 'NZ = ', I5, ' C, S = ', 1P, 2D15.5, 2 ' AND THE INDX TYPE NO. ', I5 3 /5X, 'INACCURATE COMPONENT NO. ', I5, ' HAS VALUE = ', 4 1PD15.5, ' TRUE VALUE = ', 1PD15.5, ' ERROR = ', 5 1PD12.1 ) C 1700 FORMAT ( 5X, 'DROTI OUTPUT ARRAY Y IS INACCURATE FOR TEST WITH ', 1 'NZ = ', I5, ' C, S = ', 1P, 2D15.5, 2 ' AND THE INDX TYPE NO. ', I5 3 /5X, 'INACCURATE COMPONENT NO. ', I5, ' HAS VALUE = ', 4 1PD15.5, ' TRUE VALUE = ', 1PD15.5, ' ERROR = ', 5 1PD12.1 ) C 2700 FORMAT ( /5X, 'DROTI PASSED ALL TESTS.' ) C 2800 FORMAT ( /5X, 'DROTI FAILED', I10, ' TESTS.' ) C C ================================================================== C END SUBROUTINE TDSCTR ( NOUT, NZMAX2, NUMNZ, NZVALU, 1 X, XSAVE, XTRUE, Y, YSAVE, 2 YTRUE , INDX, INDXT, ERRCNT, ERRMAX ) C C ================================================================== C ================================================================== C ==== TDSCTR -- CERTIFY DSCTR ==== C ================================================================== C ================================================================== C C SUBROUTINE TDSCTR IS THE CERTIFICATION MODULE FOR THE SPARSE C BASIC LINEAR ALGEBRA SUBROUTINE MODULE DSCTR. C C WRITTEN BY ROGER G GRIMES C APRIL 1987 C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER NOUT, NZMAX2, NUMNZ, ERRCNT, 1 ERRMAX C INTEGER NZVALU (*), INDX (*), INDXT (*) C DOUBLE PRECISION X (*), XSAVE (*), XTRUE (*), 1 Y (*), YSAVE (*), YTRUE (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER COUNT, I, ICLOBR, J, KINDX, 1 KNZ, N, NZ, NZTRUE C DOUBLE PRECISION CLOBBR C C -------------------- C ... SUBPROGRAMS USED C -------------------- C LOGICAL IVSAME, DVSAME C EXTERNAL ICOPY, DCOPY, DINIT, GNINDX, 1 IVSAME, DVSAME, DSCTR C C ================================================================== C C ------------------ C ... INITIALIZATION C ------------------ C COUNT = 0 C CLOBBR = -1.0D10 ICLOBR = -10000000 C C ------------------------------------ C ... GENERATE SOME VALUES FOR X AND Y C ------------------------------------ C DO 100 I = 1, NZMAX2 XSAVE(I) = COS ( .6*DBLE(I) ) YSAVE(I) = SIN ( .7*DBLE(I) ) 100 CONTINUE C C ------------------------ C ... FOR EACH VALUE OF NZ C ------------------------ C DO 600 KNZ = 1, NUMNZ C NZTRUE = NZVALU(KNZ) N = 2 * MAX ( NZTRUE, 1 ) C C ------------------------------- C ... FOR EACH KIND OF INDX ARRAY C ------------------------------- C DO 500 KINDX = 1, 5 C CALL GNINDX ( NZTRUE, N, ICLOBR, KINDX, INDXT ) C C ----------------------- C ... GENERATE INPUT DATA C ----------------------- C I = MIN ( N, N-NZTRUE ) J = N - I + 1 CALL DCOPY ( NZTRUE, XSAVE, 1, XTRUE, 1 ) CALL DINIT ( I, CLOBBR, XTRUE(J), 1 ) CALL DINIT ( N, CLOBBR, YTRUE, 1 ) C C ------------------- C ... COPY TRUE INPUT C ------------------- C NZ = NZTRUE C CALL DCOPY ( N, YTRUE, 1, Y, 1 ) CALL DCOPY ( N, XTRUE, 1, X, 1 ) CALL ICOPY ( N, INDXT, 1, INDX, 1 ) C C -------------------------- C ... COMPUTE IN-LINE RESULT C -------------------------- C DO 300 I = 1, NZTRUE YTRUE (INDXT(I)) = XTRUE (I) 300 CONTINUE C C -------------- C ... CALL DSCTR C -------------- C CALL DSCTR ( NZ, X, INDX, Y ) C C ---------------------------------------- C ... TEST ARGUMENTS OF DSCTR THAT ARE NOT C SUPPOSED TO CHANGE. C ---------------------------------------- C IF ( NZ .NE. NZTRUE ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1000 ) NZTRUE, KINDX, NZ END IF END IF C IF ( .NOT. DVSAME ( N, X, XTRUE ) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1100 ) NZTRUE, KINDX END IF END IF C IF ( .NOT. IVSAME ( N, INDX, INDXT ) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1200 ) NZTRUE, KINDX END IF END IF C C -------------------------- C ... TEST OUTPUT FROM DSCTR C -------------------------- C DO 400 I = 1, N IF ( Y(I) .NE. YTRUE(I) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1300 ) NZTRUE, KINDX, I, 1 Y(I), YTRUE(I) END IF END IF 400 CONTINUE C 500 CONTINUE C 600 CONTINUE C C ================================================================== C C ------------------ C ... END OF TESTING C ------------------ C ERRCNT = ERRCNT + COUNT IF ( COUNT .NE. 0 ) GO TO 800 C C ----------------------------------- C ... WRITE PASSED MESSAGE AND RETURN C ----------------------------------- C WRITE ( NOUT, 2700 ) GO TO 900 C C ----------------------------------- C ... WRITE FAILED MESSAGE AND RETURN C ----------------------------------- C 800 WRITE ( NOUT, 2800 ) COUNT C C ------------------------ C ... END OF MODULE TDSCTR C ------------------------ C 900 CONTINUE RETURN C C ================================================================== C C ----------- C ... FORMATS C ----------- C 1000 FORMAT ( 5X, 'DSCTR ALTERED NZ FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5, 2 '. ALTERED VALUE OF NZ = ', I5 ) C 1100 FORMAT ( 5X, 'DSCTR ALTERED ARRAY X FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5 ) C 1200 FORMAT ( 5X, 'DSCTR ALTERED ARRAY INDX FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5 ) C 1300 FORMAT ( 5X, 'DSCTR OUTPUT ARRAY Y IS INCORRECT FOR TEST WITH ', 1 'NZ = ', I5, ' AND THE INDX TYPE NO. ', I5 2 /5X, 'INACCURATE COMPONENT NO. ', I5, ' HAS VALUE =', 3 1PD15.5, ' TRUE VALUE =', 1PD15.5 ) C 2700 FORMAT ( /5X, 'DSCTR PASSED ALL TESTS.' ) C 2800 FORMAT ( /5X, 'DSCTR FAILED', I10, ' TESTS.' ) C C ================================================================== C END DOUBLE PRECISION FUNCTION DDIFF ( X, Y ) C C ================================================================== C C DDIFF IS USED BY THE MAIN PROGRAM TO COMPARE 1.0 + EPSILN WITH C 1.0. ITS SOLE USE IS TO FOOL AN OPTIMIZING COMPILER. C C ================================================================== C C ------------------------ C ... VARIABLE DECLARATION C ------------------------ C DOUBLE PRECISION X, Y C C ================================================================== C DDIFF = X - Y C C ================================================================== C RETURN END LOGICAL FUNCTION DVSAME ( N, DX, DY ) C C ================================================================== C C LOGICAL FUNCTION DVSAME DETERMINES IF THE VECTORS DX AND DY C AGREE EXACTLY WITH EACH OTHER. C C ================================================================== C C ------------------------ C ... VARIABLE DECLARATION C ------------------------ C INTEGER I, N C DOUBLE PRECISION DX (*), DY (*) C C ================================================================== C DVSAME = .TRUE. C DO 10 I = 1, N IF ( DX(I) .NE. DY(I) ) THEN DVSAME = .FALSE. GO TO 20 ENDIF 10 CONTINUE C 20 RETURN END SUBROUTINE ICOPY ( N, X, INCX, Y, INCY ) C C ================================================================== C ================================================================== C ==== ICOPY -- COPY ONE INTEGER VECTOR TO ANOTHER ==== C ================================================================== C ================================================================== C C PURPOSE ... (VARIANT OF 'SCOPY') C COPY ONE INTEGER VECTOR TO ANOTHER. C STANDARD INCREMENT OF 1 SHOULD BE USED FOR FORWARD C COPY WITHIN SAME VECTOR. C C CREATED ... MAR. 12, 1985 C LAST MODIFIED ... APR. 19, 1985 C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER N, INCX, INCY C INTEGER X (*), Y (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER XADDR, YADDR, I C C ================================================================== C IF ( INCX .EQ. 1 .AND. INCY .EQ. 1 ) THEN C C ----------------------------------- C ... UNIT INCREMENTS (STANDARD CASE) C ----------------------------------- C DO 100 I = 1, N Y (I) = X (I) 100 CONTINUE C ELSE C C ------------------------- C ... NON-UNIT INCREMENTS C (-1) USED FOR REVERSE C COPYING IN SAME ARRAY C ------------------------- C XADDR = 1 YADDR = 1 C IF ( INCX .LT. 0 ) THEN XADDR = (-N+1)*INCX + 1 ENDIF C IF ( INCY .LT. 0 ) THEN YADDR = (-N+1)*INCY + 1 ENDIF C DO 200 I = 1, N Y (YADDR) = X (XADDR) XADDR = XADDR + INCX YADDR = YADDR + INCY 200 CONTINUE C ENDIF C RETURN C END SUBROUTINE IINIT ( N, A, X, INCX ) C C ================================================================== C ================================================================== C ==== IINIT -- INITIALIZE INTEGER VECTOR TO CONSTANT ==== C ================================================================== C ================================================================== C C PURPOSE ... INITIALIZES INTEGER VECTOR TO A CONSTANT VALUE 'A' C C CREATED ... MAR. 8, 1985 C LAST MODIFIED ... APR. 19, 1985 C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER N, INCX C INTEGER A, X (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER XADDR, I C C ================================================================== C IF ( INCX .EQ. 1 ) THEN C C ---------------------------------- C ... UNIT INCREMENT (STANDARD CASE) C ---------------------------------- C DO 100 I = 1, N X(I) = A 100 CONTINUE C ELSE C C ---------------------- C ... NON-UNIT INCREMENT C ---------------------- C XADDR = 1 IF ( INCX .LT. 0 ) THEN XADDR = (-N+1)*INCX + 1 ENDIF C DO 200 I = 1, N X (XADDR) = A XADDR = XADDR + INCX 200 CONTINUE C ENDIF C RETURN C END SUBROUTINE GNINDX ( NZ, N, ICLOBR, KINDX, INDX ) C C ================================================================== C ================================================================== C ==== GNINDX -- GENERATE INDEX ARRAY PATTERNS ==== C ================================================================== C ================================================================== C C GNINDX GENERATES VARIOUS PATTERNS FOR THE ARRAY INDX BASED C ON THE KEY KINDX. THE GENERATED INDX ARRAY HAS NZ SIGNIFICANT C COMPONENTS. THE REMAINING N-NZ COMPONENTS ARE SET TO C ICLOBR. C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER NZ, N, ICLOBR, KINDX, INDX (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER I, L C C -------------------- C ... SUBPROGRAMS USED C -------------------- C EXTERNAL IINIT C C ================================================================== C IF ( N .LE. 0 ) RETURN C L = MAX ( N, N-NZ ) CALL IINIT ( L, ICLOBR, INDX, 1 ) C IF ( NZ .LE. 0 ) RETURN C KINDX = MAX ( KINDX, 1 ) KINDX = MIN ( KINDX, 5 ) C C ------------------- C ... BRANCH ON KINDX C ------------------- C GO TO ( 100, 200, 300, 400, 500 ), KINDX C C ----------------------------------- C ... ASCENDING ORDER - 1, 2, ..., NZ C ----------------------------------- C 100 DO 110 I = 1, NZ INDX(I) = I 110 CONTINUE GO TO 900 C C ------------------------------------------ C ... ASCENDING ORDER - N-NZ+1, N-NZ, ..., N C ------------------------------------------ C 200 L = N - NZ DO 210 I = 1, NZ INDX(I) = L + I 210 CONTINUE GO TO 900 C C --------------------------------------- C ... DESCENDING ORDER - NZ, NZ-1, ..., 1 C --------------------------------------- C 300 L = NZ DO 310 I = 1, NZ INDX(I) = L L = L -1 310 CONTINUE GO TO 900 C C ------------------------------------------ C ... DESCENDING ORDER - N, N-1, ..., N-NZ+1 C ------------------------------------------ C 400 L = N DO 410 I = 1, NZ INDX(I) = L L = L - 1 410 CONTINUE GO TO 900 C C -------------------------------------------------------- C ... ALTERNATING ORDER WITH EVEN NUMBERS IN REVERSE ORDER C -------------------------------------------------------- C 500 DO 510 I = 1, NZ, 2 INDX(I) = I 510 CONTINUE C L = N DO 520 I = 2, NZ, 2 INDX(I) = L L = L - 2 520 CONTINUE GO TO 900 C C ================================================================== C 900 RETURN END LOGICAL FUNCTION IVSAME ( N, IX, IY ) C C ================================================================== C C LOGICAL FUNCTION IVSAME DETERMINES IF THE VECTORS IX AND IY C AGREE EXACTLY WITH EACH OTHER. C C ================================================================== C C ------------------------ C ... VARIABLE DECLARATION C ------------------------ C INTEGER I, N, IX (*), IY (*) C C ================================================================== C IVSAME = .TRUE. C IF ( N .LE. 0 ) RETURN C DO 10 I = 1, N IF ( IX(I) .NE. IY(I) ) THEN IVSAME = .FALSE. GO TO 20 ENDIF 10 CONTINUE C 20 RETURN C END SUBROUTINE DCOPY ( N, X, INCX, Y, INCY ) C C ================================================================== C ================================================================== C ==== DCOPY -- COPY ONE DOUBLE PRECISION VECTOR TO ANOTHER ==== C ================================================================== C ================================================================== C C PURPOSE ... STANDARD BLAS C COPY ONE DOUBLE PRECISION VECTOR TO ANOTHER. C STANDARD INCREMENT OF 1 SHOULD BE USED FOR FORWARD C COPY WITHIN SAME VECTOR. C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER N, INCX, INCY C DOUBLE PRECISION X (*), Y (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER XADDR, YADDR, I C C ================================================================== C IF ( INCX .EQ. 1 .AND. INCY .EQ. 1 ) THEN C C ----------------------------------- C ... UNIT INCREMENTS (STANDARD CASE) C ----------------------------------- C DO 100 I = 1, N Y (I) = X (I) 100 CONTINUE C ELSE C C ------------------------- C ... NON-UNIT INCREMENTS C (-1) USED FOR REVERSE C COPYING IN SAME ARRAY C ------------------------- C XADDR = 1 YADDR = 1 C IF ( INCX .LT. 0 ) THEN XADDR = (-N+1)*INCX + 1 ENDIF C IF ( INCY .LT. 0 ) THEN YADDR = (-N+1)*INCY + 1 ENDIF C DO 200 I = 1, N Y (YADDR) = X (XADDR) XADDR = XADDR + INCX YADDR = YADDR + INCY 200 CONTINUE C ENDIF C RETURN C END C ================================================================== C ================================================================== C ==== DINIT -- INITIALIZE DOUBLE PRECISION VECTOR TO CONSTANT ==== C ================================================================== C ================================================================== C SUBROUTINE DINIT ( N, A, X, INCX ) C C ================================================================== C C PURPOSE ... INITIALIZES DOUBLE PRECISION VECTOR TO C A CONSTANT VALUE 'A' C C CREATED ... APR. 14, 1987 C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER N, INCX C DOUBLE PRECISION A, X (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER XADDR, I C C ================================================================== C IF ( INCX .EQ. 1 ) THEN C C ---------------------------------- C ... UNIT INCREMENT (STANDARD CASE) C ---------------------------------- C DO 100 I = 1, N X(I) = A 100 CONTINUE C ELSE C C ---------------------- C ... NON-UNIT INCREMENT C ---------------------- C XADDR = 1 IF ( INCX .LT. 0 ) THEN XADDR = (-N+1)*INCX + 1 ENDIF C DO 200 I = 1, N X (XADDR) = A XADDR = XADDR + INCX 200 CONTINUE C ENDIF C RETURN C END SUBROUTINE DAXPYI ( NZ, A, X, INDX, Y ) C C ================================================================== C ================================================================== C ==== DAXPYI -- INDEXED DOUBLE PRECISION ELEMENTARY ==== C ==== VECTOR OPERATION ==== C ================================================================== C ================================================================== C C PURPOSE C ------- C C DAXPYI ADDS A DOUBLE PRECISION SCALAR MULTIPLE OF C A DOUBLE PRECISION SPARSE VECTOR X C STORED IN COMPRESSED FORM (X,INDX) C TO C A DOUBLE PRECISION VECTOR Y IN FULL STORAGE FORM. C C ONLY THE ELEMENTS OF Y WHOSE INDICES ARE LISTED IN INDX C ARE REFERENCED OR MODIFIED. THE VALUES IN INDX MUST BE C DISTINCT TO ALLOW CONSISTENT VECTOR OR PARALLEL EXECUTION. C C ALTHOUGH DISTINCT INDICES WILL ALLOW VECTOR OR PARALLEL C EXECUTION, MOST COMPILERS FOR HIGH-PERFORMANCE MACHINES WILL C BE UNABLE TO GENERATE BEST POSSIBLE CODE WITHOUT SOME C MODIFICATION, SUCH AS COMPILER DIRECTIVES, TO THIS CODE. C C ARGUMENTS C --------- C C INPUT ... C C NZ INTEGER NUMBER OF ELEMENTS IN THE COMPRESSED FORM. C A DOUBLE SCALAR MULTIPLIER OF X. C X DOUBLE ARRAY CONTAINING THE VALUES OF THE C COMPRESSED FORM. C INDX INTEGER ARRAY CONTAINING THE INDICES OF THE C COMPRESSED FORM. IT IS ASSUMED THAT C THE ELEMENTS IN INDX ARE DISTINCT. C C UPDATED ... C C Y DOUBLE ARRAY, ON INPUT, WHICH CONTAINS THE VECTOR C Y IN FULL STORAGE FORM. ON OUTPUT C ONLY THE ELEMENTS CORRESPONDING TO THE C INDICES IN INDX HAVE BEEN MODIFIED. C C C SPARSE BASIC LINEAR ALGEBRA SUBPROGRAM C C FORTRAN VERSION WRITTEN OCTOBER 1984 C ROGER G GRIMES, BOEING COMPUTER SERVICES C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER NZ, INDX (*) C DOUBLE PRECISION Y (*), X (*), A C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER I C C ================================================================== C IF ( NZ .LE. 0 ) RETURN C IF ( A .EQ. 0.0D0 ) RETURN C DO 10 I = 1, NZ Y(INDX(I)) = Y(INDX(I)) + A * X(I) 10 CONTINUE C RETURN END DOUBLE PRECISION FUNCTION DDOTI ( NZ, X, INDX, Y ) C C ================================================================== C ================================================================== C ==== DDOTI -- DOUBLE PRECISION INDEXED DOT PRODUCT ==== C ================================================================== C ================================================================== C C PURPOSE C ------- C C DDOTI COMPUTES THE VECTOR INNER PRODUCT OF C A DOUBLE PRECISION SPARSE VECTOR X C STORED IN COMPRESSED FORM (X,INDX) C WITH C A DOUBLE PRECISION VECTOR Y IN FULL STORAGE FORM. C C ONLY THE ELEMENTS OF Y WHOSE INDICES ARE LISTED IN INDX C ARE REFERENCED. C C ARGUMENTS C --------- C C INPUT ... C C NZ INTEGER NUMBER OF ELEMENTS IN THE COMPRESSED FORM. C X DOUBLE ARRAY CONTAINING THE VALUES OF THE C COMPRESSED FORM. C INDX INTEGER ARRAY CONTAINING THE INDICES OF THE C COMPRESSED FORM. C Y DOUBLE ARRAY, ON INPUT, WHICH CONTAINS THE C VECTOR Y IN FULL STORAGE FORM. ONLY C THE ELEMENTS CORRESPONDING TO THE C INDICES IN INDX WILL BE ACCESSED. C C OUTPUT ... C C DDOTI DOUBLE DOUBLE PRECISION FUNCTION VALUE EQUAL TO C THE VECTOR INNER PRODUCT. C IF NZ .LE. 0 DDOTI IS SET TO ZERO. C C SPARSE BASIC LINEAR ALGEBRA SUBPROGRAM C C FORTRAN VERSION WRITTEN OCTOBER 1984 C ROGER G GRIMES, BOEING COMPUTER SERVICES C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER NZ, INDX (*) C DOUBLE PRECISION X (*), Y (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER I C C ================================================================== C DDOTI = 0.0D0 IF ( NZ .LE. 0 ) RETURN C DO 10 I = 1, NZ DDOTI = DDOTI + X(I) * Y(INDX(I)) 10 CONTINUE C RETURN END SUBROUTINE DGTHR ( NZ, Y, X, INDX ) C C ================================================================== C ================================================================== C ==== DGTHR -- DOUBLE PRECISION GATHER ==== C ================================================================== C ================================================================== C C PURPOSE C ------- C C DGTHR GATHERS THE SPECIFIED ELEMENTS FROM C A DOUBLE PRECISION VECTOR Y IN FULL STORAGE FORM C INTO C A DOUBLE PRECISION VECTOR X IN COMPRESSED FORM (X,INDX). C C ONLY THE ELEMENTS OF Y WHOSE INDICES ARE LISTED IN INDX C ARE REFERENCED. C C ARGUMENTS C --------- C C INPUT ... C C NZ INTEGER NUMBER OF ELEMENTS TO BE GATHERED INTO C COMPRESSED FORM. C Y DOUBLE ARRAY, ON INPUT, WHICH CONTAINS THE C VECTOR Y IN FULL STORAGE FORM. ONLY C THE ELEMENTS CORRESPONDING TO THE INDICES C IN INDX WILL BE ACCESSED. C INDX INTEGER ARRAY CONTAINING THE INDICES OF THE VALUES C TO BE GATHERED INTO COMPRESSED FORM. C C OUTPUT ... C C X DOUBLE ARRAY CONTAINING THE VALUES GATHERED INTO C THE COMPRESSED FORM. C C SPARSE BASIC LINEAR ALGEBRA SUBPROGRAM C C FORTRAN VERSION WRITTEN OCTOBER 1984 C ROGER G GRIMES, BOEING COMPUTER SERVICES C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C C INTEGER NZ, INDX (*) C DOUBLE PRECISION Y (*), X (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER I C C ================================================================== C IF ( NZ .LE. 0 ) RETURN C DO 10 I = 1, NZ X(I) = Y(INDX(I)) 10 CONTINUE C RETURN END SUBROUTINE DGTHRZ ( NZ, Y, X, INDX ) C C ================================================================== C ================================================================== C ==== DGTHRZ -- DOUBLE PRECISION GATHER AND ZERO ==== C ================================================================== C ================================================================== C C PURPOSE C ------- C C DGTHRZ GATHERS THE SPECIFIED ELEMENTS FROM C A DOUBLE PRECISION VECTOR Y IN FULL STORAGE FORM C INTO C A DOUBLE PRECISION VECTOR X IN COMPRESSED FORM (X,INDX). C FURTHERMORE THE GATHERED ELEMENTS OF Y ARE SET TO ZERO. C C ONLY THE ELEMENTS OF Y WHOSE INDICES ARE LISTED IN INDX C ARE REFERENCED OR MODIFIED. C C ARGUMENTS C --------- C C INPUT ... C C NZ INTEGER NUMBER OF ELEMENTS TO BE GATHERED INTO C COMPRESSED FORM. C INDX INTEGER ARRAY CONTAINING THE INDICES OF THE VALUES C TO BE GATHERED INTO COMPRESSED FORM. C C UPDATED ... C C Y DOUBLE ARRAY, ON INPUT, WHICH CONTAINS THE VECTOR C Y IN FULL STORAGE FORM. THE GATHERED C COMPONENTS IN Y ARE SET TO ZERO. C ONLY THE ELEMENTS CORRESPONDING TO THE C INDICES IN INDX HAVE BEEN ACCESSED. C C OUTPUT ... C C X DOUBLE ARRAY CONTAINING THE VALUES GATHERED INTO C THE COMPRESSED FORM. C C SPARSE BASIC LINEAR ALGEBRA SUBPROGRAM C C FORTRAN VERSION WRITTEN OCTOBER 1984 C ROGER G GRIMES, BOEING COMPUTER SERVICES C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER NZ, INDX (*) C DOUBLE PRECISION Y (*), X (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER I C C ================================================================== C IF ( NZ .LE. 0 ) RETURN C DO 10 I = 1, NZ X(I) = Y(INDX(I)) Y(INDX(I)) = 0.0D0 10 CONTINUE C RETURN END SUBROUTINE DROTI ( NZ, X, INDX, Y, C, S ) C C ================================================================== C ================================================================== C ==== DROTI -- APPLY INDEXED DOUBLE PRECISION GIVENS ==== C ==== ROTATION ==== C ================================================================== C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C C PURPOSE C ------- C C DROTI APPLIES A GIVENS ROTATION TO C A SPARSE VECTOR X STORED IN COMPRESSED FORM (X,INDX) C AND C ANOTHER VECTOR Y IN FULL STORAGE FORM. C C DROTI DOES NOT HANDLE FILL-IN IN X AND THEREFORE, IT IS C ASSUMED THAT ALL NONZERO COMPONENTS OF Y ARE LISTED IN C INDX. ONLY THE ELEMENTS OF Y WHOSE INDICES ARE LISTED IN C INDX ARE REFERENCED OR MODIFIED. THE VALUES IN INDX MUST C BE DISTINCT TO ALLOW CONSISTENT VECTOR OR PARALLEL EXECUTION. C C ALTHOUGH DISTINCT INDICES WILL ALLOW VECTOR OR PARALLEL C EXECUTION, MOST COMPILERS FOR HIGH-PERFORMANCE MACHINES WILL C BE UNABLE TO GENERATE BEST POSSIBLE CODE WITHOUT SOME C MODIFICATION, SUCH AS COMPILER DIRECTIVES, TO THIS CODE. C C ARGUMENTS C --------- C C INPUT ... C C NZ INTEGER NUMBER OF ELEMENTS IN THE COMPRESSED FORM. C INDX INTEGER ARRAY CONTAINING THE INDICES OF THE C COMPRESSED FORM. IT IS ASSUMED THAT C THE ELEMENTS IN INDX ARE DISTINCT. C C,S DOUBLE THE TWO SCALARS DEFINING THE GIVENS C ROTATION. C C UPDATED ... C C X DOUBLE ARRAY CONTAINING THE VALUES OF THE C SPARSE VECTOR IN COMPRESSED FORM. C Y DOUBLE ARRAY WHICH CONTAINS THE VECTOR Y C IN FULL STORAGE FORM. ONLY THE C ELEMENTS WHOSE INDICES ARE LISTED IN C INDX HAVE BEEN REFERENCED OR MODIFIED. C C C SPARSE BASIC LINEAR ALGEBRA SUBPROGRAM C C FORTRAN VERSION WRITTEN OCTOBER 1984 C ROGER G GRIMES, BOEING COMPUTER SERVICES C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER NZ, INDX (*) C DOUBLE PRECISION X (*), Y (*), C, S C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER I C DOUBLE PRECISION TEMP C C ================================================================== C IF ( NZ .LE. 0 ) RETURN C IF ( ( C .EQ. 1.0D0 ) .AND. ( S .EQ. 0.0D0 ) ) RETURN C DO 10 I = 1, NZ TEMP = - S * X (I) + C * Y (INDX(I)) X (I) = C * X (I) + S * Y (INDX(I)) Y (INDX(I)) = TEMP 10 CONTINUE C RETURN END SUBROUTINE DSCTR ( NZ, X, INDX, Y ) C C ================================================================== C ================================================================== C ==== DSCTR -- DOUBLE PRECISION SCATTER ==== C ================================================================== C ================================================================== C C PURPOSE C ------- C C DSCTR SCATTERS THE COMPONENTS OF C A SPARSE VECTOR X STORED IN COMPRESSED FORM (X,INDX) C INTO C SPECIFIED COMPONENTS OF A DOUBLE PRECISION VECTOR Y C IN FULL STORAGE FORM. C C ONLY THE ELEMENTS OF Y WHOSE INDICES ARE LISTED IN INDX C ARE MODIFIED. THE VALUES IN INDX MUST BE DISTINCT TO C ALLOW CONSISTENT VECTOR OR PARALLEL EXECUTION. C C ALTHOUGH DISTINCT INDICES WILL ALLOW VECTOR OR PARALLEL C EXECUTION, MOST COMPILERS FOR HIGH-PERFORMANCE MACHINES WILL C BE UNABLE TO GENERATE BEST POSSIBLE CODE WITHOUT SOME C MODIFICATION, SUCH AS COMPILER DIRECTIVES, TO THIS CODE. C C ARGUMENTS C --------- C C INPUT ... C C NZ INTEGER NUMBER OF ELEMENTS TO BE SCATTERED FROM C COMPRESSED FORM. C X DOUBLE ARRAY CONTAINING THE VALUES TO BE C SCATTERED FROM COMPRESSED FORM INTO FULL C STORAGE FORM. C INDX INTEGER ARRAY CONTAINING THE INDICES OF THE VALUES C TO BE SCATTERED FROM COMPRESSED FORM. C IT IS ASSUMED THAT THE ELEMENTS IN INDX C ARE DISTINCT. C C OUTPUT ... C C Y DOUBLE ARRAY WHOSE ELEMENTS SPECIFIED BY INDX C HAVE BEEN SET TO THE CORRESPONDING C ENTRIES OF X. ONLY THE ELEMENTS C CORRESPONDING TO THE INDICES IN INDX C HAVE BEEN MODIFIED. C C SPARSE BASIC LINEAR ALGEBRA SUBPROGRAM C C FORTRAN VERSION WRITTEN OCTOBER 1984 C ROGER G GRIMES, BOEING COMPUTER SERVICES C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER NZ, INDX (*) C DOUBLE PRECISION X (*), Y (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER I C C ================================================================== C IF ( NZ .LE. 0 ) RETURN C DO 10 I = 1, NZ Y(INDX(I)) = X(I) 10 CONTINUE C RETURN END 'DBLATS.SUMM' 6 100 5.0 16 -1 0 1 2 5 9 31 32 33 63 64 65 127 128 129 257 3 0.0 1.0 0.7 4 1. 0. -.6 .8 0. 1. .8 -.6 PROGRAM TZSPBL C C ================================================================== C ================================================================== C ==== TZSPBL -- CERTIFY COMPLEX*16 SPARSE BLAS ==== C ================================================================== C ================================================================== C C TZSPBL IS THE CERTIFICATION PROGRAM FOR THE COMPLEX*16 SPARSE C BLAS. THE APPROACH USED TO CERTIFY THE SPARSE BLAS IS AS FOLLOWS: C C 1. READ IN USER SPECIFIED INPUT ON OUTPUT UNIT, THRESHOLD VALUE C FOR TEST RATIO, AND THE SPECIFICATIONS FOR NZ, AND A. C 2. VERIFY THE CORRECTNESS OF THE USER SPECIFIED INPUT AND C ECHO TO THE OUTPUT UNIT. C 3. FOR EACH SUBPROGRAM IN THE COMPLEX*16 SPARSE BLAS C PERFORM ALL THE USER SPECIFIED TESTS AND PRINT A PASS/FAIL C MESSAGE. TESTS WHICH FAIL GENERATE ADDITIONAL OUTPUT. C C SPARSE BLAS SUBPROGRAMS WHICH ARE CERTIFIED BY THIS PROGRAM ARE C C ZAXPYI ZDOTUI ZGTHRZ C ZDOTCI ZGTHR ZSCTR C C THIS PROGRAM REQUIRES AN INPUT FILE ASSIGNED TO UNIT NIN C (CURRENTLY SET TO 5 BY A PARAMETER STATEMENT). THE DATA ON C THIS INPUT FILE CONTROLS THE OUTPUT UNIT, THE THRESHOLD VALUE C FOR THE NUMERICAL TESTING, AND THE SPECIFICATIONS FOR THE C TEST VALUES FOR THE LENGTH OF THE SPARSE VECTORS AND THE SCALARS C USED BY THE VARIOUS SUBPROGRAMS. AN EXAMPLE OF THE INPUT FILE C FOLLOWS C C LINE 1 'ZBLATS.SUMM' NAME OF OUTPUT FILE C LINE 2 6 UNIT NUMBER OF OUTPUT FILE C LINE 3 100 MAX. NO. OF PRINTED ERROR MESSAGES C LINE 4 5.0 THRESHOLD VALUE OF TEST RATIO C LINE 5 16 NUMBER OF VALUES OF NZ C LINE 6 -1 0 1 2 5 9 31 32 33 63 64 65 127 128 129 257 C VALUES OF NZ C LINE 7 3 NUMBER OF VALUES OF A FOR -AXPYI C LINE 8 (0.0,0.0) (1.0,0.0) (0.7,0.3) C VALUES OF A C C C THIS INPUT FILE IS READ USING FORTRAN-77 STANDARD LIST DIRECTED C INPUT. SINGLE QUOTES ARE REQUIRED AROUND THE NAME OF THE OUTPUT C FILE ON LINE 1. THE NUMBERS ON LINES 6 AND 8 CAN BE C DELIMITED BY BLANKS OR COMMAS. C C THIS PROGRAM WAS WRITTEN BY ROGER G. GRIMES, BOEING C COMPUTER SERVICES, BELLEVUE, WA. DURING APRIL, 1987. C C ================================================================== C C ------------------------------------ C ... PROBLEM SPECIFICATION PARAMETERS C ------------------------------------ C C NIN INPUT UNIT C NZMAX MAXIMUM VALUE OF ANY SINGLE NZ C NNZMAX MAXIMUM NUMBER OF VALUES OF NZ C NAMAX MAXIMUM NUMBER OF VALUES OF A (-AXPYI C SCALAR) C INTEGER NIN, NZMAX, NNZMAX, NAMAX C PARAMETER ( NIN = 5, NZMAX = 320, 1 NNZMAX = 24, NAMAX = 7 ) C C ================================================================== C C ----------------------- C ... COMPUTED PARAMETERS C ----------------------- C INTEGER NZMAX2 C PARAMETER ( NZMAX2 = 2 * NZMAX ) C C ================================================================== C C ------------------------ C ... VARIABLE DECLARATION C ------------------------ C CHARACTER*32 NAMOUT C INTEGER ERRCNT, ERRMAX, I, NOUT, NUMA, 1 NUMNZ C INTEGER INDX (NZMAX2), INDXT (NZMAX2), 1 LIST (NZMAX2), NZVALU(NNZMAX) C DOUBLE PRECISION EPSILN, EPSSAV, THRESH C COMPLEX*16 X (NZMAX2), Y (NZMAX2), 1 XTRUE (NZMAX2), YTRUE (NZMAX2), 2 XSAVE (NZMAX2), YSAVE (NZMAX2), 3 AVALUE(NAMAX) C C -------------------- C ... SUBPROGRAMS USED C -------------------- C DOUBLE PRECISION DDIFF C EXTERNAL TZXPYI, TZDTCI, TZDTUI, TZGTHR, TZGTHZ, 1 TZSCTR, DDIFF C C ================================================================== C ERRCNT = 0 C C ------------------------------------------------ C ... READ IN USER SPECIFIED INPUT FOR OUTPUT UNIT C ------------------------------------------------ C READ ( NIN, * ) NAMOUT READ ( NIN, * ) NOUT C C -------------------- C ... OPEN OUTPUT UNIT C -------------------- C OPEN ( UNIT = NOUT, FILE = NAMOUT, STATUS = 'NEW' ) C C ------------------------------ C ... READ IN REMAINDER OF INPUT C ------------------------------ C READ ( NIN, * ) ERRMAX READ ( NIN, * ) THRESH READ ( NIN, * ) NUMNZ C IF ( NUMNZ .GT. NNZMAX ) THEN ERRCNT = 1 WRITE ( NOUT, 1100 ) NUMNZ, NNZMAX GO TO 900 END IF C READ ( NIN, * ) ( NZVALU(I), I = 1, NUMNZ ) C READ ( NIN, * ) NUMA C IF ( NUMA .GT. NAMAX ) THEN ERRCNT = 1 WRITE ( NOUT, 1110 ) NUMA, NAMAX GO TO 900 END IF C READ ( NIN, * ) ( AVALUE(I), I = 1, NUMA ) C C ------------------------------ C ... PRINT USER SPECIFIED INPUT C ------------------------------ C WRITE ( NOUT, 1000 ) NAMOUT, NOUT, ERRMAX, THRESH WRITE ( NOUT, 1010 ) NUMNZ WRITE ( NOUT, 1020 ) ( NZVALU(I), I = 1, NUMNZ ) WRITE ( NOUT, 1030 ) NUMA WRITE ( NOUT, 1040 ) ( AVALUE(I), I = 1, NUMA ) C C ------------------------------- C ... VERIFY USER SPECIFIED INPUT C ------------------------------- C IF ( THRESH .LE. 0.0D0 ) THEN WRITE ( NOUT, 1130 ) THRESH THRESH = 10.0E0 END IF C IF ( NUMNZ .LE. 0 ) THEN WRITE ( NOUT, 1140 ) NUMNZ ERRCNT = 1 END IF C DO 100 I = 1, NUMNZ IF ( NZVALU(I) .GT. NZMAX ) THEN WRITE ( NOUT, 1150 ) I, NZVALU(I), NZMAX NZVALU(I) = NZMAX END IF 100 CONTINUE C IF ( ERRCNT .NE. 0 ) GO TO 900 C C --------------------------- C ... COMPUTE MACHINE EPSILON C --------------------------- C EPSILN = 1.0D0 EPSSAV = 1.0D0 C 200 IF ( DDIFF ( 1.0D0 + EPSILN, 1.0D0 ) .EQ. 0.0D0 ) GO TO 210 C EPSSAV = EPSILN EPSILN = EPSILN * .5D0 GO TO 200 C 210 EPSILN = EPSSAV C C ================================================================== C C ----------------------------------- C ... TEST THE COMPLEX*16 SPARSE BLAS C ----------------------------------- C C ------------------ C ... CERTIFY ZAXPYI C ------------------ C CALL TZXPYI ( NOUT, EPSILN, THRESH, NZMAX2, 1 NUMNZ, NZVALU, NUMA, AVALUE , 2 X, XSAVE, XTRUE, Y, YSAVE, YTRUE, 3 INDX, INDXT, LIST, ERRCNT, ERRMAX ) C C ------------------ C ... CERTIFY ZDOTCI C ------------------ C CALL TZDTCI ( NOUT, EPSILN, THRESH, NZMAX2, 1 NUMNZ, NZVALU, 2 X, XSAVE, XTRUE, Y, YSAVE, YTRUE, 3 INDX, INDXT, ERRCNT, ERRMAX ) C C ------------------ C ... CERTIFY ZDOTUI C ------------------ C CALL TZDTUI ( NOUT, EPSILN, THRESH, NZMAX2, 1 NUMNZ, NZVALU, 2 X, XSAVE, XTRUE, Y, YSAVE, YTRUE, 3 INDX, INDXT, ERRCNT, ERRMAX ) C C ----------------- C ... CERTIFY ZGTHR C ----------------- C CALL TZGTHR ( NOUT, NZMAX2, NUMNZ, NZVALU, 1 X, XSAVE, XTRUE, Y, YSAVE, YTRUE, 2 INDX, INDXT, ERRCNT, ERRMAX ) C C ------------------ C ... CERTIFY ZGTHRZ C ------------------ C CALL TZGTHZ ( NOUT, NZMAX2, NUMNZ, NZVALU, 1 X, XSAVE, XTRUE, Y, YSAVE, YTRUE, 2 INDX, INDXT, ERRCNT, ERRMAX ) C C ----------------- C ... CERTIFY ZSCTR C ----------------- C CALL TZSCTR ( NOUT, NZMAX2, NUMNZ, NZVALU, 1 X, XSAVE, XTRUE, Y, YSAVE, YTRUE, 2 INDX, INDXT, ERRCNT, ERRMAX ) C C ================================================================== C C ------------------------------------- C ... PRINT GLOBAL PASS OR FAIL MESSAGE C ------------------------------------- C 900 IF ( ERRCNT .EQ. 0 ) THEN WRITE ( NOUT, 2000 ) ELSE WRITE ( NOUT, 2100 ) ERRCNT END IF C C ----------------------------------------------------------- C ... END OF CERTIFICATION PROGRAM FOR COMPLEX*16 SPARSE BLAS C ----------------------------------------------------------- C STOP C C ================================================================== C C ----------- C ... FORMATS C ----------- C 1000 FORMAT( '1' /// 1 5X, 'START OF CERTIFICATION PROGRAM FOR THE ', 2 'COMPLEX*16 SPARSE BLAS' 3 /5X, '---------------------------------------', 4 '----------------------' 5 //5X, 'NAME OF OUTPUT UNIT = ', A 6 /5X, 'NUMBER OF OUTPUT UNIT = ', I10 7 /5X, 'MAX. NO. OF PRINTED ERROR MESSAGES = ', I10 8 /5X, 'THRESHOLD VALUE OF TEST RATIO = ', F10.1 ) C 1010 FORMAT ( /5X, 'NUMBER OF VALUES OF NZ = ', I10 ) C 1020 FORMAT ( /5X, 'VALUES OF NZ = ', 10I5 ) C 1030 FORMAT ( /5X, 'NUMBER OF VALUES OF A = ', I10 ) C 1040 FORMAT ( /5X, 'VALUES OF A = ', 1 3 ( 2X, '(', 1PD13.4, ',', 1PD13.4, ')' ) ) C 1100 FORMAT ( /5X, 'USER SPECIFIED NUMBER OF TEST CASES FOR THE ', 1 'NUMBER OF NONZEROES EXCEEDS PROGRAM LIMIT.' 2 /5X, 'NUMBER SPECIFIED = ', I10, 2X, 'PROGRAM LIMIT =', 3 I10 ) C 1110 FORMAT ( /5X, 'USER SPECIFIED NUMBER OF TEST CASES FOR THE ', 1 'SCALAR A EXCEEDS PROGRAM LIMIT.' 2 /5X, 'NUMBER SPECIFIED = ', I10, 2X, 'PROGRAM LIMIT =', 3 I10 ) C 1130 FORMAT ( /5X, 'USER SPECIFIED VALUE FOR THRESHOLD IS ', 1PD15.5, 1 ' WHICH IS NONPOSITIVE. IT HAS BEEN RESET TO 10.') C 1140 FORMAT ( /5X, 'USER SPECIFIED NUMBER OF VALUES OF NZ IS ', I5, 1 ' WHICH IS NONPOSITIVE. NO TESTING WILL OCCUR.' ) C 1150 FORMAT ( /5X, 'THE ', I3, '-TH USER SPECIFIED VALUE OF NZ IS ', 1 I8, ' IS LARGER THAN THE MAXIMUM ALLOWABLE ', 2 'VALUE OF NZ. IT HAS BEEN RESET TO ', I5 ) C 2000 FORMAT ( /5X, 'COMPLEX*16 SPARSE BLAS HAVE PASSED ALL TESTS.' ) C 2100 FORMAT ( /5X, 'COMPLEX*16 SPARSE BLAS HAVE FAILED ', I10, 1 ' TESTS. SEE ABOVE PRINTED ERROR MESSAGES.' ) C C ================================================================== C END SUBROUTINE TZXPYI ( NOUT, EPSILN, THRESH, NZMAX2, 1 NUMNZ, NZVALU, NUMA, AVALUE, 2 X, XSAVE, XTRUE, Y, YSAVE, 3 YTRUE , INDX, INDXT, LIST, ERRCNT, 4 ERRMAX ) C C ================================================================== C ================================================================== C ==== TZXPYI -- CERTIFY ZAXPYI ==== C ================================================================== C ================================================================== C C SUBROUTINE TZXPYI IS THE CERTIFICATION MODULE FOR THE SPARSE C BASIC LINEAR ALGEBRA SUBROUTINE MODULE ZAXPYI. C C WRITTEN BY ROGER G GRIMES C APRIL 1987 C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER NOUT, NZMAX2, NUMNZ, NUMA, ERRCNT, 1 ERRMAX C INTEGER NZVALU (*), INDX (*), INDXT (*), 1 LIST (*) C DOUBLE PRECISION EPSILN, THRESH C COMPLEX*16 AVALUE (*), 1 X (*), XSAVE (*), XTRUE (*), 2 Y (*), YSAVE (*), YTRUE (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C COMPLEX*16 A, ATRUE, CLOBBR C INTEGER COUNT, I, ICLOBR, J, KA, 1 KINDX, KNZ, N, NZ, NZTRUE C DOUBLE PRECISION ERR, S, T C C -------------------- C ... SUBPROGRAMS USED C -------------------- C LOGICAL IVSAME, ZVSAME C EXTERNAL ICOPY, ZCOPY, IINIT, ZINIT, GNINDX, 1 IVSAME, ZVSAME, ZAXPYI C C ================================================================== C C ------------------ C ... INITIALIZATION C ------------------ C COUNT = 0 C CLOBBR = ( -1.0D10, -1.0D10 ) ICLOBR = -10000000 C C ------------------------------------ C ... GENERATE SOME VALUES FOR X AND Y C ------------------------------------ C DO 100 I = 1, NZMAX2 XSAVE(I) = DCMPLX ( COS ( .6*DBLE(I) ), SIN ( .2*DBLE(I) ) ) YSAVE(I) = DCMPLX ( SIN ( .7*DBLE(I) ), COS ( .9*DBLE(I) ) ) 100 CONTINUE C C ------------------------ C ... FOR EACH VALUE OF NZ C ------------------------ C DO 700 KNZ = 1, NUMNZ C NZTRUE = NZVALU(KNZ) N = 2 * MAX ( NZTRUE, 1 ) C C ----------------------- C ... FOR EACH VALUE OF A C ----------------------- C DO 600 KA = 1, NUMA C ATRUE = AVALUE(KA) C C ------------------------------- C ... FOR EACH KIND OF INDX ARRAY C ------------------------------- C DO 500 KINDX = 1, 5 C CALL GNINDX ( NZTRUE, N, ICLOBR, KINDX, INDXT ) C CALL IINIT ( N, -1, LIST, 1 ) C DO 150 I = 1, NZTRUE LIST (INDXT(I)) = I 150 CONTINUE C C ----------------------- C ... GENERATE INPUT DATA C ----------------------- C I = MIN ( N, N-NZTRUE ) J = N - I + 1 CALL ZCOPY ( NZTRUE, XSAVE, 1, XTRUE, 1 ) CALL ZINIT ( I, CLOBBR, XTRUE(J), 1 ) CALL ZINIT ( N, CLOBBR, YTRUE, 1 ) C DO 200 I = 1, NZTRUE YTRUE (INDXT(I)) = YSAVE (INDXT(I)) 200 CONTINUE C C ------------------- C ... COPY TRUE INPUT C ------------------- C A = ATRUE NZ = NZTRUE C CALL ZCOPY ( N, YTRUE, 1, Y, 1 ) CALL ZCOPY ( N, XTRUE, 1, X, 1 ) CALL ICOPY ( N, INDXT, 1, INDX, 1 ) C C -------------------------- C ... COMPUTE IN-LINE RESULT C -------------------------- C DO 300 I = 1, NZTRUE YTRUE (INDXT(I)) = YTRUE (INDXT(I)) + 1 ATRUE * XTRUE(I) 300 CONTINUE C C --------------- C ... CALL ZAXPYI C --------------- C CALL ZAXPYI ( NZ, A, X, INDX, Y ) C C ----------------------------------------- C ... TEST ARGUMENTS OF ZAXPYI THAT ARE NOT C SUPPOSED TO CHANGE. C ----------------------------------------- C IF ( NZ .NE. NZTRUE ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1000 ) NZTRUE, ATRUE, KINDX, 1 NZ END IF END IF C IF ( A .NE. ATRUE ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1100 ) NZTRUE, ATRUE, KINDX, 1 A END IF END IF C IF ( .NOT. ZVSAME ( N, X, XTRUE ) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1200 ) NZTRUE, ATRUE, KINDX END IF END IF C IF ( .NOT. IVSAME ( N, INDX, INDXT ) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1300 ) NZTRUE, ATRUE, KINDX END IF END IF C C --------------------------- C ... TEST OUTPUT FROM ZAXPYI C --------------------------- C DO 400 J = 1, N IF ( LIST(J) .EQ. -1 ) THEN IF ( Y(J) .NE. YTRUE(J) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1400 ) NZTRUE, ATRUE, 1 KINDX, J, 2 Y(J), YTRUE(J) END IF END IF C ELSE C S = ABS ( Y(J) - YTRUE(J) ) T = ABS ( ATRUE) * ABS ( XTRUE (LIST(J))) + 1 ABS ( YTRUE(J)) ERR = S / ( EPSILN * T ) IF ( ERR .GT. THRESH ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1500 ) NZTRUE, ATRUE, 1 KINDX, J, Y(J), 2 YTRUE(J), ERR END IF END IF C END IF C 400 CONTINUE C 500 CONTINUE C 600 CONTINUE C 700 CONTINUE C C ================================================================== C C ------------------ C ... END OF TESTING C ------------------ C ERRCNT = ERRCNT + COUNT IF ( COUNT .NE. 0 ) GO TO 800 C C ----------------------------------- C ... WRITE PASSED MESSAGE AND RETURN C ----------------------------------- C WRITE ( NOUT, 2700 ) GO TO 900 C C ----------------------------------- C ... WRITE FAILED MESSAGE AND RETURN C ----------------------------------- C 800 WRITE ( NOUT, 2800 ) COUNT C C ------------------------ C ... END OF MODULE TZXPYI C ------------------------ C 900 CONTINUE RETURN C C ================================================================== C C ----------- C ... FORMATS C ----------- C 1000 FORMAT ( 5X, 'ZAXPYI ALTERED NZ FOR TEST WITH NZ = ', I5, 1 ' A = (', 1PD15.5, ',', 1PD15.5, 2 ') AND THE INDX TYPE NO. ', I5 3 /5X, 'ALTERED VALUE OF NZ = ', I5 ) C 1100 FORMAT ( 5X, 'ZAXPYI ALTERED A FOR TEST WITH NZ = ', I5, 1 ' A = (', 1PD15.5, ',', 1PD15.5, 2 ') AND THE INDX TYPE NO. ', I5 3 /5X, 'ALTERED VALUE OF A = (', 1PD15.5, ',', 4 1PD15.5, ')' ) C 1200 FORMAT ( 5X, 'ZAXPYI ALTERED ARRAY X FOR TEST WITH NZ = ', I5, 1 ' A = (', 1PD15.5, ',', 1PD15.5, 2 ') AND THE INDX TYPE NO. ', I5 ) C 1300 FORMAT ( 5X, 'ZAXPYI ALTERED ARRAY INDX FOR TEST WITH NZ = ', I5, 1 ' A = (', 1PD15.5, ',', 1PD15.5, 2 ') AND THE INDX TYPE NO. ', I5 ) C 1400 FORMAT ( 5X, 'ZAXPYI OUTPUT ARRAY Y IS INCORRECT FOR TEST WITH ', 1 'NZ = ', I5, ' A = (', 1PD15.5, ',', 1PD15.5, 2 ') AND THE INDX TYPE NO. ', I5 3 /5X, 'INCORRECT COMPONENT NO. ', I5, ' HAS VALUE = (', 4 1PD15.5, ',', 1PD15.5, 5 ') TRUE VALUE = (', 1PD15.5, ',', 1PD15.5, ')' ) C 1500 FORMAT ( 5X, 'ZAXPYI OUTPUT ARRAY Y IS INACCURATE FOR TEST WITH ', 1 'NZ = ', I5, ' A = (', 1PD15.5, ',', 1PD15.5, 2 ') AND THE INDX TYPE NO. ', I5 3 /5X, 'INACCURATE COMPONENT NO. ', I5, ' HAS VALUE = (', 4 1PD15.5, ',', 1PD15.5, ') TRUE VALUE = (', 5 1PD15.5, ',', 1PD15.5, ')' 6 /5X, 'ERROR = ', 1PD12.1 ) C 2700 FORMAT ( /5X, 'ZAXPYI PASSED ALL TESTS.' ) C 2800 FORMAT ( /5X, 'ZAXPYI FAILED', I10, ' TESTS.' ) C C ================================================================== C END SUBROUTINE TZDTCI ( NOUT, EPSILN, THRESH, NZMAX2, 1 NUMNZ, NZVALU, 2 X, XSAVE, XTRUE, Y, YSAVE, 3 YTRUE , INDX, INDXT, ERRCNT, ERRMAX ) C C ================================================================== C ================================================================== C ==== TZDTCI -- CERTIFY ZDOTCI ==== C ================================================================== C ================================================================== C C SUBROUTINE TZDTCI IS THE CERTIFICATION MODULE FOR THE SPARSE C BASIC LINEAR ALGEBRA SUBROUTINE MODULE ZDOTCI. C C WRITTEN BY ROGER G GRIMES C APRIL 1987 C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER NOUT, NZMAX2, NUMNZ, ERRCNT, 1 ERRMAX C INTEGER NZVALU (*), INDX (*), INDXT (*) C DOUBLE PRECISION EPSILN, THRESH C COMPLEX*16 X (*), XSAVE (*), XTRUE (*), 1 Y (*), YSAVE (*), YTRUE (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER COUNT, I, ICLOBR, J, KINDX, 1 KNZ, N, NZ, NZTRUE C DOUBLE PRECISION ERR, S, T C COMPLEX*16 CLOBBR, V, W C C -------------------- C ... SUBPROGRAMS USED C -------------------- C LOGICAL IVSAME, ZVSAME C COMPLEX*16 ZDOTCI C EXTERNAL ICOPY, ZCOPY, ZINIT, GNINDX, 1 IVSAME, ZVSAME, ZDOTCI C C ================================================================== C C ------------------ C ... INITIALIZATION C ------------------ C COUNT = 0 C CLOBBR = ( -1.0D10, -1.0D10 ) ICLOBR = -10000000 C C ------------------------------------ C ... GENERATE SOME VALUES FOR X AND Y C ------------------------------------ C DO 100 I = 1, NZMAX2 XSAVE(I) = DCMPLX ( COS ( .6*DBLE(I) ), SIN ( .2*DBLE(I) ) ) YSAVE(I) = DCMPLX ( SIN ( .7*DBLE(I) ), COS ( .9*DBLE(I) ) ) 100 CONTINUE C C ------------------------ C ... FOR EACH VALUE OF NZ C ------------------------ C DO 600 KNZ = 1, NUMNZ C NZTRUE = NZVALU(KNZ) N = 2 * MAX ( NZTRUE, 1 ) C C ------------------------------- C ... FOR EACH KIND OF INDX ARRAY C ------------------------------- C DO 500 KINDX = 1, 5 C CALL GNINDX ( NZTRUE, N, ICLOBR, KINDX, INDXT ) C C ----------------------- C ... GENERATE INPUT DATA C ----------------------- C I = MIN ( N, N-NZTRUE ) J = N - I + 1 CALL ZCOPY ( NZTRUE, XSAVE, 1, XTRUE, 1 ) CALL ZINIT ( I, CLOBBR, XTRUE(J), 1 ) CALL ZINIT ( N, CLOBBR, YTRUE, 1 ) C DO 200 I = 1, NZTRUE YTRUE (INDXT(I)) = YSAVE (INDXT(I)) 200 CONTINUE C C ------------------- C ... COPY TRUE INPUT C ------------------- C NZ = NZTRUE C CALL ZCOPY ( N, YTRUE, 1, Y, 1 ) CALL ZCOPY ( N, XTRUE, 1, X, 1 ) CALL ICOPY ( N, INDXT, 1, INDX, 1 ) C C -------------------------- C ... COMPUTE IN-LINE RESULT C -------------------------- C V = ( 0.0D0, 0.0D0 ) C DO 300 I = 1, NZTRUE V = V + DCONJG ( XTRUE(I) ) * YTRUE (INDXT(I)) 300 CONTINUE C C -------------- C ... CALL ZDOTCI C -------------- C W = ZDOTCI ( NZ, X, INDX, Y ) C C ----------------------------------------- C ... TEST ARGUMENTS OF ZDOTCI THAT ARE NOT C SUPPOSED TO CHANGE. C ----------------------------------------- C IF ( NZ .NE. NZTRUE ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1000 ) NZTRUE, KINDX, NZ END IF END IF C IF ( .NOT. ZVSAME ( N, X, XTRUE ) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1100 ) NZTRUE, KINDX END IF END IF C IF ( .NOT. IVSAME ( N, INDX, INDXT ) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1200 ) NZTRUE, KINDX END IF END IF C IF ( .NOT. ZVSAME ( N, Y, YTRUE ) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1300 ) NZTRUE, KINDX END IF END IF C C -------------------------- C ... TEST OUTPUT FROM ZDOTCI C -------------------------- C S = ABS ( V - W ) C T = 0.0D0 DO 400 I = 1, NZTRUE T = T + ABS ( XTRUE(I) * YTRUE (INDXT(I)) ) 400 CONTINUE C IF ( T .EQ. 0.0D0 ) T = 1.0D0 C ERR = S / ( EPSILN * T ) C IF ( ERR .GT. THRESH ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1400 ) NZTRUE, KINDX, 1 W, V, ERR END IF END IF C 500 CONTINUE C 600 CONTINUE C C ================================================================== C C ------------------ C ... END OF TESTING C ------------------ C ERRCNT = ERRCNT + COUNT IF ( COUNT .NE. 0 ) GO TO 800 C C ----------------------------------- C ... WRITE PASSED MESSAGE AND RETURN C ----------------------------------- C WRITE ( NOUT, 2700 ) GO TO 900 C C ----------------------------------- C ... WRITE FAILED MESSAGE AND RETURN C ----------------------------------- C 800 WRITE ( NOUT, 2800 ) COUNT C C ------------------------ C ... END OF MODULE TZDTCI C ------------------------ C 900 CONTINUE RETURN C C ================================================================== C C ----------- C ... FORMATS C ----------- C 1000 FORMAT ( 5X, 'ZDOTCI ALTERED NZ FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5, 2 '. ALTERED VALUE OF NZ = ', I5 ) C 1100 FORMAT ( 5X, 'ZDOTCI ALTERED ARRAY X FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5 ) C 1200 FORMAT ( 5X, 'ZDOTCI ALTERED ARRAY INDX FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5 ) C 1300 FORMAT ( 5X, 'ZDOTCI ALTERED ARRAY Y FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5 ) C 1400 FORMAT ( 5X, 'ZDOTCI OUTPUT W IS INACCURATE FOR TEST WITH ', 1 'NZ = ', I5, ' AND THE INDX TYPE NO. ', I5 2 /5X, 'ZDOTCI HAS VALUE = (', 1PD15.5, ',', 1PD15.5, 3 ') TRUE VALUE = (', 1PD15.5, ',', 1PD15.5, 4 ') ERROR = ', 1PD12.1 ) C 2700 FORMAT ( /5X, 'ZDOTCI PASSED ALL TESTS.' ) C 2800 FORMAT ( /5X, 'ZDOTCI FAILED', I10, ' TESTS.' ) C C ================================================================== C END SUBROUTINE TZDTUI ( NOUT, EPSILN, THRESH, NZMAX2, 1 NUMNZ, NZVALU, 2 X, XSAVE, XTRUE, Y, YSAVE, 3 YTRUE , INDX, INDXT, ERRCNT, ERRMAX ) C C ================================================================== C ================================================================== C ==== TZDTUI -- CERTIFY ZDOTUI ==== C ================================================================== C ================================================================== C C SUBROUTINE TZDTUI IS THE CERTIFICATION MODULE FOR THE SPARSE C BASIC LINEAR ALGEBRA SUBROUTINE MODULE ZDOTUI. C C WRITTEN BY ROGER G GRIMES C APRIL 1987 C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER NOUT, NZMAX2, NUMNZ, ERRCNT, 1 ERRMAX C INTEGER NZVALU (*), INDX (*), INDXT (*) C DOUBLE PRECISION EPSILN, THRESH C COMPLEX*16 X (*), XSAVE (*), XTRUE (*), 1 Y (*), YSAVE (*), YTRUE (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER COUNT, I, ICLOBR, J, KINDX, 1 KNZ, N, NZ, NZTRUE C DOUBLE PRECISION ERR, S, T C COMPLEX*16 CLOBBR, V, W C C -------------------- C ... SUBPROGRAMS USED C -------------------- C LOGICAL IVSAME, ZVSAME C COMPLEX*16 ZDOTUI C EXTERNAL ICOPY, ZCOPY, ZINIT, GNINDX, 1 IVSAME, ZVSAME, ZDOTUI C C ================================================================== C C ------------------ C ... INITIALIZATION C ------------------ C COUNT = 0 C CLOBBR = ( -1.0D10, -1.0D10 ) ICLOBR = -10000000 C C ------------------------------------ C ... GENERATE SOME VALUES FOR X AND Y C ------------------------------------ C DO 100 I = 1, NZMAX2 XSAVE(I) = DCMPLX ( COS ( .6*DBLE(I) ), SIN ( .2*DBLE(I) ) ) YSAVE(I) = DCMPLX ( SIN ( .7*DBLE(I) ), COS ( .9*DBLE(I) ) ) 100 CONTINUE C C ------------------------ C ... FOR EACH VALUE OF NZ C ------------------------ C DO 600 KNZ = 1, NUMNZ C NZTRUE = NZVALU(KNZ) N = 2 * MAX ( NZTRUE, 1 ) C C ------------------------------- C ... FOR EACH KIND OF INDX ARRAY C ------------------------------- C DO 500 KINDX = 1, 5 C CALL GNINDX ( NZTRUE, N, ICLOBR, KINDX, INDXT ) C C ----------------------- C ... GENERATE INPUT DATA C ----------------------- C I = MIN ( N, N-NZTRUE ) J = N - I + 1 CALL ZCOPY ( NZTRUE, XSAVE, 1, XTRUE, 1 ) CALL ZINIT ( I, CLOBBR, XTRUE(J), 1 ) CALL ZINIT ( N, CLOBBR, YTRUE, 1 ) C DO 200 I = 1, NZTRUE YTRUE (INDXT(I)) = YSAVE (INDXT(I)) 200 CONTINUE C C ------------------- C ... COPY TRUE INPUT C ------------------- C NZ = NZTRUE C CALL ZCOPY ( N, YTRUE, 1, Y, 1 ) CALL ZCOPY ( N, XTRUE, 1, X, 1 ) CALL ICOPY ( N, INDXT, 1, INDX, 1 ) C C -------------------------- C ... COMPUTE IN-LINE RESULT C -------------------------- C V = ( 0.0D0, 0.0D0 ) C DO 300 I = 1, NZTRUE V = V + XTRUE(I) * YTRUE (INDXT(I)) 300 CONTINUE C C -------------- C ... CALL ZDOTUI C -------------- C W = ZDOTUI ( NZ, X, INDX, Y ) C C ----------------------------------------- C ... TEST ARGUMENTS OF ZDOTUI THAT ARE NOT C SUPPOSED TO CHANGE. C ----------------------------------------- C IF ( NZ .NE. NZTRUE ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1000 ) NZTRUE, KINDX, NZ END IF END IF C IF ( .NOT. ZVSAME ( N, X, XTRUE ) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1100 ) NZTRUE, KINDX END IF END IF C IF ( .NOT. IVSAME ( N, INDX, INDXT ) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1200 ) NZTRUE, KINDX END IF END IF C IF ( .NOT. ZVSAME ( N, Y, YTRUE ) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1300 ) NZTRUE, KINDX END IF END IF C C -------------------------- C ... TEST OUTPUT FROM ZDOTUI C -------------------------- C S = ABS ( V - W ) C T = 0.0D0 DO 400 I = 1, NZTRUE T = T + ABS ( XTRUE(I) * YTRUE (INDXT(I)) ) 400 CONTINUE C IF ( T .EQ. 0.0D0 ) T = 1.0D0 C ERR = S / ( EPSILN * T ) C IF ( ERR .GT. THRESH ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1400 ) NZTRUE, KINDX, 1 W, V, ERR END IF END IF C 500 CONTINUE C 600 CONTINUE C C ================================================================== C C ------------------ C ... END OF TESTING C ------------------ C ERRCNT = ERRCNT + COUNT IF ( COUNT .NE. 0 ) GO TO 800 C C ----------------------------------- C ... WRITE PASSED MESSAGE AND RETURN C ----------------------------------- C WRITE ( NOUT, 2700 ) GO TO 900 C C ----------------------------------- C ... WRITE FAILED MESSAGE AND RETURN C ----------------------------------- C 800 WRITE ( NOUT, 2800 ) COUNT C C ------------------------ C ... END OF MODULE TZDTUI C ------------------------ C 900 CONTINUE RETURN C C ================================================================== C C ----------- C ... FORMATS C ----------- C 1000 FORMAT ( 5X, 'ZDOTUI ALTERED NZ FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5, 2 '. ALTERED VALUE OF NZ = ', I5 ) C 1100 FORMAT ( 5X, 'ZDOTUI ALTERED ARRAY X FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5 ) C 1200 FORMAT ( 5X, 'ZDOTUI ALTERED ARRAY INDX FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5 ) C 1300 FORMAT ( 5X, 'ZDOTUI ALTERED ARRAY Y FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5 ) C 1400 FORMAT ( 5X, 'ZDOTUI OUTPUT W IS INACCURATE FOR TEST WITH ', 1 'NZ = ', I5, ' AND THE INDX TYPE NO. ', I5 2 /5X, 'ZDOTUI HAS VALUE = (', 1PD15.5, ',', 1PD15.5, 3 ') TRUE VALUE = (', 1PD15.5, ',', 1PD15.5, 4 ') ERROR = ', 1PD12.1 ) C 2700 FORMAT ( /5X, 'ZDOTUI PASSED ALL TESTS.' ) C 2800 FORMAT ( /5X, 'ZDOTUI FAILED', I10, ' TESTS.' ) C C ================================================================== C END SUBROUTINE TZGTHR ( NOUT, NZMAX2, NUMNZ, NZVALU, 1 X, XSAVE, XTRUE, Y, YSAVE, 2 YTRUE , INDX, INDXT, ERRCNT, ERRMAX ) C C ================================================================== C ================================================================== C ==== TZGTHR -- CERTIFY ZGTHR ==== C ================================================================== C ================================================================== C C SUBROUTINE TZGTHR IS THE CERTIFICATION MODULE FOR THE SPARSE C BASIC LINEAR ALGEBRA SUBROUTINE MODULE ZGTHR. C C WRITTEN BY ROGER G GRIMES C APRIL 1987 C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER NOUT, NZMAX2, NUMNZ, ERRCNT, 1 ERRMAX C INTEGER NZVALU (*), INDX (*), INDXT (*) C COMPLEX*16 X (*), XSAVE (*), XTRUE (*), 1 Y (*), YSAVE (*), YTRUE (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER COUNT, I, ICLOBR, KINDX, 1 KNZ, N, NZ, NZTRUE C COMPLEX*16 CLOBBR C C -------------------- C ... SUBPROGRAMS USED C -------------------- C LOGICAL IVSAME, ZVSAME C EXTERNAL ICOPY, ZCOPY, ZINIT, GNINDX, 1 IVSAME, ZVSAME, ZGTHR C C ================================================================== C C ------------------ C ... INITIALIZATION C ------------------ C COUNT = 0 C CLOBBR = ( -1.0D10, -1.0D10 ) ICLOBR = -10000000 C C ------------------------------------ C ... GENERATE SOME VALUES FOR X AND Y C ------------------------------------ C DO 100 I = 1, NZMAX2 XSAVE(I) = DCMPLX ( COS ( .6*DBLE(I) ), SIN ( .2*DBLE(I) ) ) YSAVE(I) = DCMPLX ( SIN ( .7*DBLE(I) ), COS ( .9*DBLE(I) ) ) 100 CONTINUE C C ------------------------ C ... FOR EACH VALUE OF NZ C ------------------------ C DO 600 KNZ = 1, NUMNZ C NZTRUE = NZVALU(KNZ) N = 2 * MAX ( NZTRUE, 1 ) C C ------------------------------- C ... FOR EACH KIND OF INDX ARRAY C ------------------------------- C DO 500 KINDX = 1, 5 C CALL GNINDX ( NZTRUE, N, ICLOBR, KINDX, INDXT ) C C ----------------------- C ... GENERATE INPUT DATA C ----------------------- C CALL ZINIT ( N, CLOBBR, XTRUE, 1 ) CALL ZINIT ( N, CLOBBR, YTRUE, 1 ) C DO 200 I = 1, NZTRUE YTRUE (INDXT(I)) = YSAVE (INDXT(I)) 200 CONTINUE C C ------------------- C ... COPY TRUE INPUT C ------------------- C NZ = NZTRUE C CALL ZCOPY ( N, YTRUE, 1, Y, 1 ) CALL ZCOPY ( N, XTRUE, 1, X, 1 ) CALL ICOPY ( N, INDXT, 1, INDX, 1 ) C C -------------------------- C ... COMPUTE IN-LINE RESULT C -------------------------- C DO 300 I = 1, NZTRUE XTRUE (I) = YTRUE (INDXT(I)) 300 CONTINUE C C -------------- C ... CALL ZGTHR C -------------- C CALL ZGTHR ( NZ, Y, X, INDX ) C C ---------------------------------------- C ... TEST ARGUMENTS OF ZGTHR THAT ARE NOT C SUPPOSED TO CHANGE. C ---------------------------------------- C IF ( NZ .NE. NZTRUE ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1000 ) NZTRUE, KINDX, NZ END IF END IF C IF ( .NOT. ZVSAME ( N, Y, YTRUE ) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1100 ) NZTRUE, KINDX END IF END IF C IF ( .NOT. IVSAME ( N, INDX, INDXT ) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1200 ) NZTRUE, KINDX END IF END IF C C -------------------------- C ... TEST OUTPUT FROM ZGTHR C -------------------------- C DO 400 I = 1, N IF ( X(I) .NE. XTRUE(I) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1300 ) NZTRUE, KINDX, I, 1 X(I), XTRUE(I) END IF END IF 400 CONTINUE C 500 CONTINUE C 600 CONTINUE C C ================================================================== C C ------------------ C ... END OF TESTING C ------------------ C ERRCNT = ERRCNT + COUNT IF ( COUNT .NE. 0 ) GO TO 800 C C ----------------------------------- C ... WRITE PASSED MESSAGE AND RETURN C ----------------------------------- C WRITE ( NOUT, 2700 ) GO TO 900 C C ----------------------------------- C ... WRITE FAILED MESSAGE AND RETURN C ----------------------------------- C 800 WRITE ( NOUT, 2800 ) COUNT C C ------------------------ C ... END OF MODULE TZGTHR C ------------------------ C 900 CONTINUE RETURN C C ================================================================== C C ----------- C ... FORMATS C ----------- C 1000 FORMAT ( 5X, 'ZGTHR ALTERED NZ FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5, 2 '. ALTERED VALUE OF NZ = ', I5 ) C 1100 FORMAT ( 5X, 'ZGTHR ALTERED ARRAY Y FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5 ) C 1200 FORMAT ( 5X, 'ZGTHR ALTERED ARRAY INDX FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5 ) C 1300 FORMAT ( 5X, 'ZGTHR OUTPUT ARRAY X IS INCORRECT FOR TEST WITH ', 1 'NZ = ', I5, ' AND THE INDX TYPE NO. ', I5 2 /5X, 'INACCURATE COMPONENT NO. ', I5, ' HAS VALUE = (', 3 1PD15.5, ',', 1PD15.5, ') TRUE VALUE = (', 4 1PD15.5, ',', 1PD15.5, ')' ) C 2700 FORMAT ( /5X, 'ZGTHR PASSED ALL TESTS.' ) C 2800 FORMAT ( /5X, 'ZGTHR FAILED', I10, ' TESTS.' ) C C ================================================================== C END SUBROUTINE TZGTHZ ( NOUT, NZMAX2, NUMNZ, NZVALU, 1 X, XSAVE, XTRUE, Y, YSAVE, 2 YTRUE , INDX, INDXT, ERRCNT, ERRMAX ) C C ================================================================== C ================================================================== C ==== TZGTHZ -- CERTIFY ZGTHRZ ==== C ================================================================== C ================================================================== C C SUBROUTINE TZGTHZ IS THE CERTIFICATION MODULE FOR THE SPARSE C BASIC LINEAR ALGEBRA SUBROUTINE MODULE ZGTHRZ. C C WRITTEN BY ROGER G GRIMES C APRIL 1987 C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER NOUT, NZMAX2, NUMNZ, ERRCNT, 1 ERRMAX C INTEGER NZVALU (*), INDX (*), INDXT (*) C COMPLEX*16 X (*), XSAVE (*), XTRUE (*), 1 Y (*), YSAVE (*), YTRUE (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER COUNT, I, ICLOBR, KINDX, 1 KNZ, N, NZ, NZTRUE C COMPLEX*16 CLOBBR C C -------------------- C ... SUBPROGRAMS USED C -------------------- C LOGICAL IVSAME, ZVSAME C EXTERNAL ICOPY, ZCOPY, ZINIT, GNINDX, 1 IVSAME, ZVSAME, ZGTHRZ C C ================================================================== C C ------------------ C ... INITIALIZATION C ------------------ C COUNT = 0 C CLOBBR = ( -1.0D10, -1.0D10 ) ICLOBR = -10000000 C C ------------------------------------ C ... GENERATE SOME VALUES FOR X AND Y C ------------------------------------ C DO 100 I = 1, NZMAX2 XSAVE(I) = DCMPLX ( COS ( .6*DBLE(I) ), SIN ( .2*DBLE(I) ) ) YSAVE(I) = DCMPLX ( SIN ( .7*DBLE(I) ), COS ( .9*DBLE(I) ) ) 100 CONTINUE C C ------------------------ C ... FOR EACH VALUE OF NZ C ------------------------ C DO 600 KNZ = 1, NUMNZ C NZTRUE = NZVALU(KNZ) N = 2 * MAX ( NZTRUE, 1 ) C C ------------------------------- C ... FOR EACH KIND OF INDX ARRAY C ------------------------------- C DO 500 KINDX = 1, 5 C CALL GNINDX ( NZTRUE, N, ICLOBR, KINDX, INDXT ) C C ----------------------- C ... GENERATE INPUT DATA C ----------------------- C CALL ZINIT ( N, CLOBBR, XTRUE, 1 ) CALL ZINIT ( N, CLOBBR, YTRUE, 1 ) C DO 200 I = 1, NZTRUE YTRUE (INDXT(I)) = YSAVE (INDXT(I)) 200 CONTINUE C C ------------------- C ... COPY TRUE INPUT C ------------------- C NZ = NZTRUE C CALL ZCOPY ( N, YTRUE, 1, Y, 1 ) CALL ZCOPY ( N, XTRUE, 1, X, 1 ) CALL ICOPY ( N, INDXT, 1, INDX, 1 ) C C -------------------------- C ... COMPUTE IN-LINE RESULT C -------------------------- C DO 300 I = 1, NZTRUE XTRUE (I) = YTRUE (INDXT(I)) YTRUE(INDXT(I)) = ( 0.0D0, 0.0D0 ) 300 CONTINUE C C --------------- C ... CALL ZGTHRZ C --------------- C CALL ZGTHRZ ( NZ, Y, X, INDX ) C C ----------------------------------------- C ... TEST ARGUMENTS OF ZGTHRZ THAT ARE NOT C SUPPOSED TO CHANGE. C ----------------------------------------- C IF ( NZ .NE. NZTRUE ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1000 ) NZTRUE, KINDX, NZ END IF END IF C IF ( .NOT. IVSAME ( N, INDX, INDXT ) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1100 ) NZTRUE, KINDX END IF END IF C C --------------------------- C ... TEST OUTPUT FROM ZGTHRZ C --------------------------- C DO 400 I = 1, N C IF ( X(I) .NE. XTRUE(I) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1200 ) NZTRUE, KINDX, I, 1 X(I), XTRUE(I) END IF END IF C IF ( Y(I) .NE. YTRUE(I) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1300 ) NZTRUE, KINDX, I, 1 Y(I), YTRUE(I) END IF END IF C 400 CONTINUE C 500 CONTINUE C 600 CONTINUE C C ================================================================== C C ------------------ C ... END OF TESTING C ------------------ C ERRCNT = ERRCNT + COUNT IF ( COUNT .NE. 0 ) GO TO 800 C C ----------------------------------- C ... WRITE PASSED MESSAGE AND RETURN C ----------------------------------- C WRITE ( NOUT, 2700 ) GO TO 900 C C ----------------------------------- C ... WRITE FAILED MESSAGE AND RETURN C ----------------------------------- C 800 WRITE ( NOUT, 2800 ) COUNT C C ------------------------ C ... END OF MODULE TZGTHZ C ------------------------ C 900 CONTINUE RETURN C C ================================================================== C C ----------- C ... FORMATS C ----------- C 1000 FORMAT ( 5X, 'ZGTHRZ ALTERED NZ FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5, 2 '. ALTERED VALUE OF NZ = ', I5 ) C 1100 FORMAT ( 5X, 'ZGTHRZ ALTERED ARRAY INDX FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5 ) C 1200 FORMAT ( 5X, 'ZGTHRZ OUTPUT ARRAY X IS INCORRECT FOR TEST WITH ', 1 'NZ = ', I5, ' AND THE INDX TYPE NO. ', I5 2 /5X, 'INACCURATE COMPONENT NO. ', I5, ' HAS VALUE = (', 3 1PD15.5, ',', 1PD15.5, ') TRUE VALUE = (', 4 1PD15.5, ',', 1PD15.5, ')' ) C 1300 FORMAT ( 5X, 'ZGTHRZ OUTPUT ARRAY Y IS INCORRECT FOR TEST WITH ', 1 'NZ = ', I5, ' AND THE INDX TYPE NO. ', I5 2 /5X, 'INACCURATE COMPONENT NO. ', I5, ' HAS VALUE = (', 3 1PD15.5, ',', 1PD15.5, ') TRUE VALUE = (', 4 1PD15.5, ',', 1PD15.5, ')' ) C 2700 FORMAT ( /5X, 'ZGTHRZ PASSED ALL TESTS.' ) C 2800 FORMAT ( /5X, 'ZGTHRZ FAILED', I10, ' TESTS.' ) C C ================================================================== C END SUBROUTINE TZSCTR ( NOUT, NZMAX2, NUMNZ, NZVALU, 1 X, XSAVE, XTRUE, Y, YSAVE, 2 YTRUE , INDX, INDXT, ERRCNT, ERRMAX ) C C ================================================================== C ================================================================== C ==== TZSCTR -- CERTIFY ZSCTR ==== C ================================================================== C ================================================================== C C SUBROUTINE TZSCTR IS THE CERTIFICATION MODULE FOR THE SPARSE C BASIC LINEAR ALGEBRA SUBROUTINE MODULE ZSCTR. C C WRITTEN BY ROGER G GRIMES C APRIL 1987 C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER NOUT, NZMAX2, NUMNZ, ERRCNT, 1 ERRMAX C INTEGER NZVALU (*), INDX (*), INDXT (*) C COMPLEX*16 X (*), XSAVE (*), XTRUE (*), 1 Y (*), YSAVE (*), YTRUE (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER COUNT, I, ICLOBR, J, KINDX, 1 KNZ, N, NZ, NZTRUE C COMPLEX*16 CLOBBR C C -------------------- C ... SUBPROGRAMS USED C -------------------- C LOGICAL IVSAME, ZVSAME C EXTERNAL ICOPY, ZCOPY, ZINIT, GNINDX, 1 IVSAME, ZVSAME, ZSCTR C C ================================================================== C C ------------------ C ... INITIALIZATION C ------------------ C COUNT = 0 C CLOBBR = ( -1.0D10, -1.0D10 ) ICLOBR = -10000000 C C ------------------------------------ C ... GENERATE SOME VALUES FOR X AND Y C ------------------------------------ C DO 100 I = 1, NZMAX2 XSAVE(I) = DCMPLX ( COS ( .6*DBLE(I) ), SIN ( .2*DBLE(I) ) ) YSAVE(I) = DCMPLX ( SIN ( .7*DBLE(I) ), COS ( .9*DBLE(I) ) ) 100 CONTINUE C C ------------------------ C ... FOR EACH VALUE OF NZ C ------------------------ C DO 600 KNZ = 1, NUMNZ C NZTRUE = NZVALU(KNZ) N = 2 * MAX ( NZTRUE, 1 ) C C ------------------------------- C ... FOR EACH KIND OF INDX ARRAY C ------------------------------- C DO 500 KINDX = 1, 5 C CALL GNINDX ( NZTRUE, N, ICLOBR, KINDX, INDXT ) C C ----------------------- C ... GENERATE INPUT DATA C ----------------------- C I = MIN ( N, N-NZTRUE ) J = N - I + 1 CALL ZCOPY ( NZTRUE, XSAVE, 1, XTRUE, 1 ) CALL ZINIT ( I, CLOBBR, XTRUE(J), 1 ) CALL ZINIT ( N, CLOBBR, YTRUE, 1 ) C C ------------------- C ... COPY TRUE INPUT C ------------------- C NZ = NZTRUE C CALL ZCOPY ( N, YTRUE, 1, Y, 1 ) CALL ZCOPY ( N, XTRUE, 1, X, 1 ) CALL ICOPY ( N, INDXT, 1, INDX, 1 ) C C -------------------------- C ... COMPUTE IN-LINE RESULT C -------------------------- C DO 300 I = 1, NZTRUE YTRUE (INDXT(I)) = XTRUE (I) 300 CONTINUE C C -------------- C ... CALL ZSCTR C -------------- C CALL ZSCTR ( NZ, X, INDX, Y ) C C ---------------------------------------- C ... TEST ARGUMENTS OF ZSCTR THAT ARE NOT C SUPPOSED TO CHANGE. C ---------------------------------------- C IF ( NZ .NE. NZTRUE ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1000 ) NZTRUE, KINDX, NZ END IF END IF C IF ( .NOT. ZVSAME ( N, X, XTRUE ) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1100 ) NZTRUE, KINDX END IF END IF C IF ( .NOT. IVSAME ( N, INDX, INDXT ) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1200 ) NZTRUE, KINDX END IF END IF C C -------------------------- C ... TEST OUTPUT FROM ZSCTR C -------------------------- C DO 400 I = 1, N IF ( Y(I) .NE. YTRUE(I) ) THEN COUNT = COUNT + 1 IF ( COUNT .LE. ERRMAX ) THEN WRITE ( NOUT, 1300 ) NZTRUE, KINDX, I, 1 Y(I), YTRUE(I) END IF END IF 400 CONTINUE C 500 CONTINUE C 600 CONTINUE C C ================================================================== C C ------------------ C ... END OF TESTING C ------------------ C ERRCNT = ERRCNT + COUNT IF ( COUNT .NE. 0 ) GO TO 800 C C ----------------------------------- C ... WRITE PASSED MESSAGE AND RETURN C ----------------------------------- C WRITE ( NOUT, 2700 ) GO TO 900 C C ----------------------------------- C ... WRITE FAILED MESSAGE AND RETURN C ----------------------------------- C 800 WRITE ( NOUT, 2800 ) COUNT C C ------------------------ C ... END OF MODULE TZSCTR C ------------------------ C 900 CONTINUE RETURN C C ================================================================== C C ----------- C ... FORMATS C ----------- C 1000 FORMAT ( 5X, 'ZSCTR ALTERED NZ FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5, 2 '. ALTERED VALUE OF NZ = ', I5 ) C 1100 FORMAT ( 5X, 'ZSCTR ALTERED ARRAY X FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5 ) C 1200 FORMAT ( 5X, 'ZSCTR ALTERED ARRAY INDX FOR TEST WITH NZ = ', I5, 1 ' AND THE INDX TYPE NO. ', I5 ) C 1300 FORMAT ( 5X, 'ZSCTR OUTPUT ARRAY Y IS INCORRECT FOR TEST WITH ', 1 'NZ = ', I5, ' AND THE INDX TYPE NO. ', I5 2 /5X, 'INACCURATE COMPONENT NO. ', I5, ' HAS VALUE = (', 3 1PD15.5, ',', 1PD15.5, ') TRUE VALUE = (', 4 1PD15.5, ',', 1PD15.5, ')' ) C 2700 FORMAT ( /5X, 'ZSCTR PASSED ALL TESTS.' ) C 2800 FORMAT ( /5X, 'ZSCTR FAILED', I10, ' TESTS.' ) C C ================================================================== C END DOUBLE PRECISION FUNCTION DDIFF ( X, Y ) C C ================================================================== C C DDIFF IS USED BY THE MAIN PROGRAM TO COMPARE 1.0 + EPSILN WITH C 1.0. ITS SOLE USE IS TO FOOL AN OPTIMIZING COMPILER. C C ================================================================== C C ------------------------ C ... VARIABLE DECLARATION C ------------------------ C DOUBLE PRECISION X, Y C C ================================================================== C DDIFF = X - Y C C ================================================================== C RETURN END LOGICAL FUNCTION ZVSAME ( N, ZX, ZY ) C C ================================================================== C C LOGICAL FUNCTION ZVSAME DETERMINES IF THE VECTORS ZX AND ZY C AGREE EXACTLY WITH EACH OTHER. C C ================================================================== C C ------------------------ C ... VARIABLE DECLARATION C ------------------------ C INTEGER I, N C COMPLEX * 16 ZX (*), ZY (*) C C ================================================================== C ZVSAME = .TRUE. C DO 10 I = 1, N IF ( ZX(I) .NE. ZY(I) ) THEN ZVSAME = .FALSE. GO TO 20 ENDIF 10 CONTINUE C 20 RETURN END SUBROUTINE ICOPY ( N, X, INCX, Y, INCY ) C C ================================================================== C ================================================================== C ==== ICOPY -- COPY ONE INTEGER VECTOR TO ANOTHER ==== C ================================================================== C ================================================================== C C PURPOSE ... (VARIANT OF 'SCOPY') C COPY ONE INTEGER VECTOR TO ANOTHER. C STANDARD INCREMENT OF 1 SHOULD BE USED FOR FORWARD C COPY WITHIN SAME VECTOR. C C CREATED ... MAR. 12, 1985 C LAST MODIFIED ... APR. 19, 1985 C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER N, INCX, INCY C INTEGER X (*), Y (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER XADDR, YADDR, I C C ================================================================== C IF ( INCX .EQ. 1 .AND. INCY .EQ. 1 ) THEN C C ----------------------------------- C ... UNIT INCREMENTS (STANDARD CASE) C ----------------------------------- C DO 100 I = 1, N Y (I) = X (I) 100 CONTINUE C ELSE C C ------------------------- C ... NON-UNIT INCREMENTS C (-1) USED FOR REVERSE C COPYING IN SAME ARRAY C ------------------------- C XADDR = 1 YADDR = 1 C IF ( INCX .LT. 0 ) THEN XADDR = (-N+1)*INCX + 1 ENDIF C IF ( INCY .LT. 0 ) THEN YADDR = (-N+1)*INCY + 1 ENDIF C DO 200 I = 1, N Y (YADDR) = X (XADDR) XADDR = XADDR + INCX YADDR = YADDR + INCY 200 CONTINUE C ENDIF C RETURN C END SUBROUTINE IINIT ( N, A, X, INCX ) C C ================================================================== C ================================================================== C ==== IINIT -- INITIALIZE INTEGER VECTOR TO CONSTANT ==== C ================================================================== C ================================================================== C C PURPOSE ... INITIALIZES INTEGER VECTOR TO A CONSTANT VALUE 'A' C C CREATED ... MAR. 8, 1985 C LAST MODIFIED ... APR. 19, 1985 C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER N, INCX C INTEGER A, X (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER XADDR, I C C ================================================================== C IF ( INCX .EQ. 1 ) THEN C C ---------------------------------- C ... UNIT INCREMENT (STANDARD CASE) C ---------------------------------- C DO 100 I = 1, N X(I) = A 100 CONTINUE C ELSE C C ---------------------- C ... NON-UNIT INCREMENT C ---------------------- C XADDR = 1 IF ( INCX .LT. 0 ) THEN XADDR = (-N+1)*INCX + 1 ENDIF C DO 200 I = 1, N X (XADDR) = A XADDR = XADDR + INCX 200 CONTINUE C ENDIF C RETURN C END SUBROUTINE GNINDX ( NZ, N, ICLOBR, KINDX, INDX ) C C ================================================================== C ================================================================== C ==== GNINDX -- GENERATE INDEX ARRAY PATTERNS ==== C ================================================================== C ================================================================== C C GNINDX GENERATES VARIOUS PATTERNS FOR THE ARRAY INDX BASED C ON THE KEY KINDX. THE GENERATED INDX ARRAY HAS NZ SIGNIFICANT C COMPONENTS. THE REMAINING N-NZ COMPONENTS ARE SET TO C ICLOBR. C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER NZ, N, ICLOBR, KINDX, INDX (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER I, L C C -------------------- C ... SUBPROGRAMS USED C -------------------- C EXTERNAL IINIT C C ================================================================== C IF ( N .LE. 0 ) RETURN C L = MAX ( N, N-NZ ) CALL IINIT ( L, ICLOBR, INDX, 1 ) C IF ( NZ .LE. 0 ) RETURN C KINDX = MAX ( KINDX, 1 ) KINDX = MIN ( KINDX, 5 ) C C ------------------- C ... BRANCH ON KINDX C ------------------- C GO TO ( 100, 200, 300, 400, 500 ), KINDX C C ----------------------------------- C ... ASCENDING ORDER - 1, 2, ..., NZ C ----------------------------------- C 100 DO 110 I = 1, NZ INDX(I) = I 110 CONTINUE GO TO 900 C C ------------------------------------------ C ... ASCENDING ORDER - N-NZ+1, N-NZ, ..., N C ------------------------------------------ C 200 L = N - NZ DO 210 I = 1, NZ INDX(I) = L + I 210 CONTINUE GO TO 900 C C --------------------------------------- C ... DESCENDING ORDER - NZ, NZ-1, ..., 1 C --------------------------------------- C 300 L = NZ DO 310 I = 1, NZ INDX(I) = L L = L -1 310 CONTINUE GO TO 900 C C ------------------------------------------ C ... DESCENDING ORDER - N, N-1, ..., N-NZ+1 C ------------------------------------------ C 400 L = N DO 410 I = 1, NZ INDX(I) = L L = L - 1 410 CONTINUE GO TO 900 C C -------------------------------------------------------- C ... ALTERNATING ORDER WITH EVEN NUMBERS IN REVERSE ORDER C -------------------------------------------------------- C 500 DO 510 I = 1, NZ, 2 INDX(I) = I 510 CONTINUE C L = N DO 520 I = 2, NZ, 2 INDX(I) = L L = L - 2 520 CONTINUE GO TO 900 C C ================================================================== C 900 RETURN END LOGICAL FUNCTION IVSAME ( N, IX, IY ) C C ================================================================== C C LOGICAL FUNCTION IVSAME DETERMINES IF THE VECTORS IX AND IY C AGREE EXACTLY WITH EACH OTHER. C C ================================================================== C C ------------------------ C ... VARIABLE DECLARATION C ------------------------ C INTEGER I, N, IX (*), IY (*) C C ================================================================== C IVSAME = .TRUE. C IF ( N .LE. 0 ) RETURN C DO 10 I = 1, N IF ( IX(I) .NE. IY(I) ) THEN IVSAME = .FALSE. GO TO 20 ENDIF 10 CONTINUE C 20 RETURN C END SUBROUTINE ZCOPY ( N, X, INCX, Y, INCY ) C C ================================================================== C ================================================================== C ==== ZCOPY -- COPY ONE DOUBLE COMPLEX VECTOR TO ANOTHER ==== C ================================================================== C ================================================================== C C PURPOSE ... STANDARD BLAS C COPY ONE DOUBLE COMPLEX VECTOR TO ANOTHER. C STANDARD INCREMENT OF 1 SHOULD BE USED FOR FORWARD C COPY WITHIN SAME VECTOR. C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER N, INCX, INCY C COMPLEX * 16 X (*), Y (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER XADDR, YADDR, I C C ================================================================== C IF ( INCX .EQ. 1 .AND. INCY .EQ. 1 ) THEN C C ----------------------------------- C ... UNIT INCREMENTS (STANDARD CASE) C ----------------------------------- C DO 100 I = 1, N Y (I) = X (I) 100 CONTINUE C ELSE C C ------------------------- C ... NON-UNIT INCREMENTS C (-1) USED FOR REVERSE C COPYING IN SAME ARRAY C ------------------------- C XADDR = 1 YADDR = 1 C IF ( INCX .LT. 0 ) THEN XADDR = (-N+1)*INCX + 1 ENDIF C IF ( INCY .LT. 0 ) THEN YADDR = (-N+1)*INCY + 1 ENDIF C DO 200 I = 1, N Y (YADDR) = X (XADDR) XADDR = XADDR + INCX YADDR = YADDR + INCY 200 CONTINUE C ENDIF C RETURN C END C ================================================================== C ================================================================== C ==== ZINIT -- INITIALIZE DOUBLE COMPLEX VECTOR TO CONSTANT ==== C ================================================================== C ================================================================== C SUBROUTINE ZINIT ( N, A, X, INCX ) C C ================================================================== C C PURPOSE ... INITIALIZES DOUBLE COMPLEX VECTOR TO C A CONSTANT VALUE 'A' C C CREATED ... APR. 14, 1987 C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER N, INCX C COMPLEX * 16 A, X (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER XADDR, I C C ================================================================== C IF ( INCX .EQ. 1 ) THEN C C ---------------------------------- C ... UNIT INCREMENT (STANDARD CASE) C ---------------------------------- C DO 100 I = 1, N X(I) = A 100 CONTINUE C ELSE C C ---------------------- C ... NON-UNIT INCREMENT C ---------------------- C XADDR = 1 IF ( INCX .LT. 0 ) THEN XADDR = (-N+1)*INCX + 1 ENDIF C DO 200 I = 1, N X (XADDR) = A XADDR = XADDR + INCX 200 CONTINUE C ENDIF C RETURN C END SUBROUTINE ZAXPYI ( NZ, A, X, INDX, Y ) C C ================================================================== C ================================================================== C ==== ZAXPYI -- INDEXED COMPLEX*16 ELEMENTARY VECTOR OPERATION === C ================================================================== C ================================================================== C C PURPOSE C ------- C C ZAXPYI ADDS A COMPLEX*16 SCALAR MULTIPLE OF C A COMPLEX*16 SPARSE VECTOR X C STORED IN COMPRESSED FORM (X,INDX) C TO C A COMPLEX*16 VECTOR Y IN FULL STORAGE FORM. C C ONLY THE ELEMENTS OF Y WHOSE INDICES ARE LISTED IN INDX C ARE REFERENCED OR MODIFIED. THE VALUES IN INDX MUST BE C DISTINCT TO ALLOW CONSISTENT VECTOR OR PARALLEL EXECUTION. C C ALTHOUGH DISTINCT INDICES WILL ALLOW VECTOR OR PARALLEL C EXECUTION, MOST COMPILERS FOR HIGH-PERFORMANCE MACHINES WILL C BE UNABLE TO GENERATE BEST POSSIBLE CODE WITHOUT SOME C MODIFICATION, SUCH AS COMPILER DIRECTIVES, TO THIS CODE. C C ARGUMENTS C --------- C C INPUT ... C C NZ INTEGER NUMBER OF ELEMENTS IN THE COMPRESSED FORM. C A COMPLEX*16 SCALAR MULTIPLIER OF X. C X COMPLEX*16 ARRAY CONTAINING THE VALUES OF THE C COMPRESSED FORM. C INDX INTEGER ARRAY CONTAINING THE INDICES OF THE C COMPRESSED FORM. IT IS ASSUMED THAT C THE ELEMENTS IN INDX ARE DISTINCT. C C UPDATED ... C C Y COMPLEX*16 ARRAY, ON INPUT, WHICH CONTAINS THE VECTOR C Y IN FULL STORAGE FORM. ON OUTPUT C ONLY THE ELEMENTS CORRESPONDING TO THE C INDICES IN INDX HAVE BEEN MODIFIED. C C C SPARSE BASIC LINEAR ALGEBRA SUBPROGRAM C C FORTRAN VERSION WRITTEN OCTOBER 1984 C ROGER G GRIMES, BOEING COMPUTER SERVICES C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER NZ, INDX (*) C COMPLEX*16 Y (*), X (*), A C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER I C C ================================================================== C IF ( NZ .LE. 0 ) RETURN C IF ( A .EQ. ( 0.0D0, 0.0D0 ) ) RETURN C DO 10 I = 1, NZ Y(INDX(I)) = Y(INDX(I)) + A * X(I) 10 CONTINUE C RETURN END FUNCTION ZDOTCI ( NZ, X, INDX, Y ) C C ================================================================== C ================================================================== C ==== ZDOTCI -- COMPLEX*16 CONJUGATED INDEXED DOT PRODUCT ==== C ================================================================== C ================================================================== C C PURPOSE C ------- C C ZDOTCI COMPUTES THE CONJUGATED VECTOR INNER PRODUCT OF C A COMPLEX*16 SPARSE VECTOR X C STORED IN COMPRESSED FORM (X,INDX) C WITH C A COMPLEX*16 VECTOR Y IN FULL STORAGE FORM. C C ONLY THE ELEMENTS OF Y WHOSE INDICES ARE LISTED IN INDX C ARE REFERENCED. C C ARGUMENTS C --------- C C INPUT ... C C NZ INTEGER NUMBER OF ELEMENTS IN THE COMPRESSED FORM. C X COMPLEX*16 ARRAY CONTAINING THE VALUES OF THE C COMPRESSED FORM. C INDX INTEGER ARRAY CONTAINING THE INDICES OF THE C COMPRESSED FORM. C Y COMPLEX*16 ARRAY, ON INPUT, WHICH CONTAINS THE C VECTOR Y IN FULL STORAGE FORM. ONLY C THE ELEMENTS CORRESPONDING TO THE C INDICES IN INDX WILL BE ACCESSED. C C OUTPUT ... C C ZDOTCI COMPLEX*16 COMPLEX*16 FUNCTION VALUE EQUAL TO THE C CONJUGATED VECTOR INNER PRODUCT. C IF NZ .LE. 0 ZDOTCI IS SET TO ZERO. C C SPARSE BASIC LINEAR ALGEBRA SUBPROGRAM C C FORTRAN VERSION WRITTEN OCTOBER 1984 C ROGER G GRIMES, BOEING COMPUTER SERVICES C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER NZ, INDX (*) C COMPLEX*16 X (*), Y (*), ZDOTCI C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER I C C ================================================================== C ZDOTCI = ( 0.0D0, 0.0D0 ) IF ( NZ .LE. 0 ) RETURN C DO 10 I = 1, NZ ZDOTCI = ZDOTCI + DCONJG ( X(I) ) * Y(INDX(I)) 10 CONTINUE C RETURN END FUNCTION ZDOTUI ( NZ, X, INDX, Y ) C C ================================================================== C ================================================================== C ==== ZDOTUI -- COMPLEX*16 UNCONJUGATED INDEXED DOT PRODUCT ==== C ================================================================== C ================================================================== C C PURPOSE C ------- C C ZDOTUI COMPUTES THE UNCONJUGATED VECTOR INNER PRODUCT OF C A COMPLEX*16 SPARSE VECTOR X C STORED IN COMPRESSED FORM (X,INDX) C WITH C A COMPLEX*16 VECTOR Y IN FULL STORAGE FORM. C C ONLY THE ELEMENTS OF Y WHOSE INDICES ARE LISTED IN INDX C ARE REFERENCED. C C ARGUMENTS C --------- C C INPUT ... C C NZ INTEGER NUMBER OF ELEMENTS IN THE COMPRESSED FORM. C X COMPLEX*16 ARRAY CONTAINING THE VALUES OF THE C COMPRESSED FORM. C INDX INTEGER ARRAY CONTAINING THE INDICES OF THE C COMPRESSED FORM. C Y COMPLEX*16 ARRAY, ON INPUT, WHICH CONTAINS THE C VECTOR Y IN FULL STORAGE FORM. ONLY C THE ELEMENTS CORRESPONDING TO THE C INDICES IN INDX WILL BE ACCESSED. C C OUTPUT ... C C ZDOTUI COMPLEX*16 COMPLEX*16 FUNCTION VALUE EQUAL TO THE C UNCONJUGATED VECTOR INNER PRODUCT. C IF NZ .LE. 0 ZDOTCI IS SET TO ZERO. C C SPARSE BASIC LINEAR ALGEBRA SUBPROGRAM C C FORTRAN VERSION WRITTEN OCTOBER 1984 C ROGER G GRIMES, BOEING COMPUTER SERVICES C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER NZ, INDX (*) C COMPLEX*16 X (*), Y (*), ZDOTUI C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER I C C ================================================================== C ZDOTUI = ( 0.0D0, 0.0D0 ) IF ( NZ .LE. 0 ) RETURN C DO 10 I = 1, NZ ZDOTUI = ZDOTUI + X(I) * Y(INDX(I)) 10 CONTINUE C RETURN END SUBROUTINE ZGTHR ( NZ, Y, X, INDX ) C C ================================================================== C ================================================================== C ==== ZGTHR -- COMPLEX*16 GATHER ==== C ================================================================== C ================================================================== C C PURPOSE C ------- C C ZGTHR GATHERS THE SPECIFIED ELEMENTS FROM C A COMPLEX*16 VECTOR Y IN FULL STORAGE FORM C INTO C A COMPLEX*16 VECTOR X IN COMPRESSED FORM (X,INDX). C C ONLY THE ELEMENTS OF Y WHOSE INDICES ARE LISTED IN INDX C ARE REFERENCED. C C ARGUMENTS C --------- C C INPUT ... C C NZ INTEGER NUMBER OF ELEMENTS TO BE GATHERED INTO C COMPRESSED FORM. C Y COMPLEX*16 ARRAY, ON INPUT, WHICH CONTAINS THE C VECTOR Y IN FULL STORAGE FORM. ONLY C THE ELEMENTS CORRESPONDING TO THE INDICES C IN INDX WILL BE ACCESSED. C INDX INTEGER ARRAY CONTAINING THE INDICES OF THE VALUES C TO BE GATHERED INTO COMPRESSED FORM. C C OUTPUT ... C C X COMPLEX*16 ARRAY CONTAINING THE VALUES GATHERED INTO C THE COMPRESSED FORM. C C SPARSE BASIC LINEAR ALGEBRA SUBPROGRAM C C FORTRAN VERSION WRITTEN OCTOBER 1984 C ROGER G GRIMES, BOEING COMPUTER SERVICES C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C C INTEGER NZ, INDX (*) C COMPLEX*16 Y (*), X (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER I C C ================================================================== C IF ( NZ .LE. 0 ) RETURN C DO 10 I = 1, NZ X(I) = Y(INDX(I)) 10 CONTINUE C RETURN END SUBROUTINE ZGTHRZ ( NZ, Y, X, INDX ) C C ================================================================== C ================================================================== C ==== ZGTHRZ -- COMPLEX*16 GATHER AND ZERO ==== C ================================================================== C ================================================================== C C PURPOSE C ------- C C ZGTHRZ GATHERS THE SPECIFIED ELEMENTS FROM C A COMPLEX*16 VECTOR Y IN FULL STORAGE FORM C INTO C A COMPLEX*16 VECTOR X IN COMPRESSED FORM (X,INDX). C FURTHERMORE THE GATHERED ELEMENTS OF Y ARE SET TO ZERO. C C ONLY THE ELEMENTS OF Y WHOSE INDICES ARE LISTED IN INDX C ARE REFERENCED OR MODIFIED. C C ARGUMENTS C --------- C C INPUT ... C C NZ INTEGER NUMBER OF ELEMENTS TO BE GATHERED INTO C COMPRESSED FORM. C INDX INTEGER ARRAY CONTAINING THE INDICES OF THE VALUES C TO BE GATHERED INTO COMPRESSED FORM. C C UPDATED ... C C Y COMPLEX*16 ARRAY, ON INPUT, WHICH CONTAINS THE VECTOR C Y IN FULL STORAGE FORM. THE GATHERED C COMPONENTS IN Y ARE SET TO ZERO. C ONLY THE ELEMENTS CORRESPONDING TO THE C INDICES IN INDX HAVE BEEN ACCESSED. C C OUTPUT ... C C X COMPLEX*16 ARRAY CONTAINING THE VALUES GATHERED INTO C THE COMPRESSED FORM. C C SPARSE BASIC LINEAR ALGEBRA SUBPROGRAM C C FORTRAN VERSION WRITTEN OCTOBER 1984 C ROGER G GRIMES, BOEING COMPUTER SERVICES C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER NZ, INDX (*) C COMPLEX*16 Y (*), X (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER I C C ================================================================== C IF ( NZ .LE. 0 ) RETURN C DO 10 I = 1, NZ X(I) = Y(INDX(I)) Y(INDX(I)) = ( 0.0D0, 0.0D0 ) 10 CONTINUE C RETURN END SUBROUTINE ZSCTR ( NZ, X, INDX, Y ) C C ================================================================== C ================================================================== C ==== ZSCTR -- COMPLEX*16 SCATTER ==== C ================================================================== C ================================================================== C C PURPOSE C ------- C C ZSCTR SCATTERS THE COMPONENTS OF C A SPARSE VECTOR X STORED IN COMPRESSED FORM (X,INDX) C INTO C SPECIFIED COMPONENTS OF A COMPLEX*16 VECTOR Y C IN FULL STORAGE FORM. C C ONLY THE ELEMENTS OF Y WHOSE INDICES ARE LISTED IN INDX C ARE MODIFIED. THE VALUES IN INDX MUST BE DISTINCT TO C ALLOW CONSISTENT VECTOR OR PARALLEL EXECUTION. C C ALTHOUGH DISTINCT INDICES WILL ALLOW VECTOR OR PARALLEL C EXECUTION, MOST COMPILERS FOR HIGH-PERFORMANCE MACHINES WILL C BE UNABLE TO GENERATE BEST POSSIBLE CODE WITHOUT SOME C MODIFICATION, SUCH AS COMPILER DIRECTIVES, TO THIS CODE. C C ARGUMENTS C --------- C C INPUT ... C C NZ INTEGER NUMBER OF ELEMENTS TO BE SCATTERED FROM C COMPRESSED FORM. C X COMPLEX*16 ARRAY CONTAINING THE VALUES TO BE C SCATTERED FROM COMPRESSED FORM INTO FULL C STORAGE FORM. C INDX INTEGER ARRAY CONTAINING THE INDICES OF THE VALUES C TO BE SCATTERED FROM COMPRESSED FORM. C IT IS ASSUMED THAT THE ELEMENTS IN INDX C ARE DISTINCT. C C OUTPUT ... C C Y COMPLEX*16 ARRAY WHOSE ELEMENTS SPECIFIED BY INDX C HAVE BEEN SET TO THE CORRESPONDING C ENTRIES OF X. ONLY THE ELEMENTS C CORRESPONDING TO THE INDICES IN INDX C HAVE BEEN MODIFIED. C C SPARSE BASIC LINEAR ALGEBRA SUBPROGRAM C C FORTRAN VERSION WRITTEN OCTOBER 1984 C ROGER G GRIMES, BOEING COMPUTER SERVICES C C ================================================================== C C ------------- C ... ARGUMENTS C ------------- C INTEGER NZ, INDX (*) C COMPLEX*16 X (*), Y (*) C C ------------------- C ... LOCAL VARIABLES C ------------------- C INTEGER I C C ================================================================== C IF ( NZ .LE. 0 ) RETURN C DO 10 I = 1, NZ Y(INDX(I)) = X(I) 10 CONTINUE C RETURN END 'ZBLATS.SUMM' 6 100 5.0 16 -1 0 1 2 3 9 31 32 33 63 64 65 127 128 129 257 3 (0.0,0.0) (1.0,0.0) (0.7,0.3)