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)