PROGRAM DRMATRIX
C
C     Driver for testing single precision MATRIX routines.
C     Martin J. McBride.  10/16/85.
C     General Electric CRD, Information System Operation.
C
C     FORTRAN logical unit numbers used:
C         Input:    3       One line containing CRAY information
C         Input:   11       Input data for MATRIX routines
C         Output:  12       Output data for MATRIX routines
C
      PARAMETER(NROUTS = 5)
      CHARACTER ROUTNME*31,SUBNAME*31,IDENT*5,DATEIN*8
      CHARACTER DATERUN*8,COMMENTS*23,HRDWRE*30
      CHARACTER DUMMY*30,PERSON*5
      INTEGER NTESTS,NFAILS,TTESTS,TFAILS,TEMP
      DOUBLE PRECISION TOL,PFAILS
      DIMENSION NTESTS(NROUTS),NFAILS(NROUTS),SUBNAME(NROUTS)
      DATA NTESTS,NFAILS /NROUTS*0,NROUTS*0/

C  An array is set up to hold the names of the 3 FILTER subprograms.
      SUBNAME(1) = 'MXM'
      SUBNAME(2) = 'MXV'
      SUBNAME(3) = 'MXMA'
      SUBNAME(4) = 'MXVA'
      SUBNAME(5) = 'MINV'

C  Initialization of tolerance value and CRAY information.
      TOL = 0.00001
      READ(3,505) HRDWRE
      CLOSE(3)

C  Initialization of data heading.
      READ(11,500,END=99) ROUTNME,IDENT,DATEIN,PERSON,DATERUN,COMMENTS
   15 IF (ROUTNME .NE. ' ') GO TO 20
         READ(11,500,END=99) ROUTNME,IDENT,DATEIN,PERSON,DATERUN,
     -       COMMENTS
         GO TO 15

C  Loop to run through all sets of input data, which ends with XXX.
   20 IF (ROUTNME .EQ. 'XXX') GO TO 99
         READ(11,505) DUMMY
         CALL FDATE(DATERUN)
         WRITE(12,590)
         WRITE(12,590)
         WRITE(12,600) ROUTNME,IDENT,DATEIN,PERSON,DATERUN,COMMENTS
         WRITE(12,605) HRDWRE
  500    FORMAT(A31,A5,A8,A5,A8,A23)
  505    FORMAT(A30)
  590    FORMAT(1X)
  600    FORMAT(A31,A5,A8,A5,A8,A23)
  605    FORMAT(A30)

C  Determine which subprogram is currently being tested.
         IF (ROUTNME .EQ. 'MXM') THEN
            TEMP = NFAILS(1)
            CALL DRMXM(NTESTS(1),NFAILS(1),TOL)
            IF (NFAILS(1) .GT. TEMP) WRITE(6,900) IDENT
         ELSE IF (ROUTNME .EQ. 'MXV') THEN
            TEMP = NFAILS(2)
            CALL DRMXV(NTESTS(2),NFAILS(2),TOL)
            IF (NFAILS(2) .GT. TEMP) WRITE(6,900) IDENT
         ELSE IF (ROUTNME .EQ. 'MXMA') THEN
            TEMP = NFAILS(3)
            CALL DRMXMA(NTESTS(3),NFAILS(3),TOL)
            IF (NFAILS(3) .GT. TEMP) WRITE(6,900) IDENT
         ELSE IF (ROUTNME .EQ. 'MXVA') THEN
            TEMP = NFAILS(4)
            CALL DRMXVA(NTESTS(4),NFAILS(4),TOL)
            IF (NFAILS(4) .GT. TEMP) WRITE(6,900) IDENT
         ELSE IF (ROUTNME .EQ. 'MINV') THEN
            TEMP = NFAILS(5)
            CALL DRMINV(NTESTS(5),NFAILS(5),TOL)
            IF (NFAILS(5) .GT. TEMP) WRITE(6,900) IDENT
         ELSE
            PRINT*,'ERROR IN ROUTINE NAME --- ',ROUTNME
            PRINT*,'  IDENTIFICATION # ',IDENT
            STOP
         ENDIF
  900    FORMAT(1X,'ERROR IN SCIPORT RESULT - DATA ID# ',A5)

C  Read next data heading.
         READ(11,500,END=99) ROUTNME,IDENT,DATEIN,PERSON,DATERUN,COMMENTS
   30    IF (ROUTNME .NE. ' ') GO TO 20
            READ(11,500,END=99) ROUTNME,IDENT,DATEIN,PERSON,DATERUN,
     &                COMMENTS
            GO TO 30

C  Print XXX at bottom of output file and proceed to printing of results.
   99 CONTINUE
      WRITE(12,590)
      WRITE(12,590)
      WRITE(12,600) ROUTNME

C  Output of results of each individual test case.
      DO 55 I = 1,NROUTS
         WRITE(6,700)
         WRITE(6,705) SUBNAME(I)
         IF (NTESTS(I) .EQ. 0) THEN
            WRITE(6,708)
            WRITE(6,707)
            WRITE(6,708)
         ELSE IF (NFAILS(I) .GT. 0) THEN
            PFAILS = DBLE(NFAILS(I))/DBLE(NTESTS(I)) * 100.0
            WRITE(6,708)
            WRITE(6,710) NTESTS(I)
            WRITE(6,715) NFAILS(I)
            WRITE(6,720) PFAILS
            WRITE(6,708)
         ELSE
            WRITE(6,710) NTESTS(I)
            WRITE(6,730)
         ENDIF
   55 CONTINUE

C  Computation and output of totals.
      TTESTS = 0
      TFAILS = 0
      DO 65 I = 1,NROUTS
         TTESTS = TTESTS + NTESTS(I)
         TFAILS = TFAILS + NFAILS(I)
   65 CONTINUE
      WRITE(6,700)
      WRITE(6,700)
      WRITE(6,701)
      WRITE(6,700)
      WRITE(6,702)
      PFAILS = DBLE(TFAILS)/DBLE(TTESTS) * 100.0
      WRITE(6,710) TTESTS
      WRITE(6,715) TFAILS
      WRITE(6,720) PFAILS
      WRITE(6,700)

  700 FORMAT(1X)
  701 FORMAT(1X,50('-'))
  702 FORMAT(1X,'TOTALS')
  705 FORMAT(1X,A31)
  707 FORMAT(5X,'There were no tests performed on this unit.')
  708 FORMAT(45X,'******')
  710 FORMAT(5X,'Number of tests performed:    ',I4)
  715 FORMAT(5X,'Number of tests that failed:  ',I4)
  720 FORMAT(5X,'Percentage of failures:     ',F6.2)
  730 FORMAT(5X,'All tests on this unit were successful.')

      CLOSE(11)
      CLOSE(12)
      END

C-------------------------------------------------------------     ************
C                                                                     DRMXM
C                                                                  ************
      SUBROUTINE DRMXM(NTESTS,NFAILS,TOL)
C
C     Test driver for MXM.
C     Martin J. McBride.  11/8/85.
C     General Electric CRD, Information System Operation.
C
      PARAMETER(MAX = 400)
      CHARACTER*10 STR1,STR2,STR3,STR4,STR5,STR6,MESS*5
      LOGICAL FAILED
      INTEGER NTESTS,NFAILS,NAR,NAC,NBC,I,J
      DOUBLE PRECISION A,B,C,CRC,TOL,DIFF
      DIMENSION A(MAX),B(MAX),C(MAX),CRC(MAX)

C  Functions to help input a matrix into a one-dimensional array.
      INA(I,J) = NAR*(J-1) + I
      INB(I,J) = NAC*(J-1) + I
      INC(I,J) = NAR*(J-1) + I

C  Input matrix data and previous results.
      READ(11,*) STR1,NAR
      READ(11,*) STR2,NAC
      READ(11,*) STR3,NBC
      MESS = 'DRMXM'
      CALL DIMCHECK(NAR*NAC,MAX,MESS)
      CALL DIMCHECK(NAC*NBC,MAX,MESS)
      CALL DIMCHECK(NAR*NBC,MAX,MESS)
      READ(11,*) STR4
      DO 10 I = 1,NAR
   10    READ(11,*) (A(INA(I,J)), J=1,NAC)
      READ(11,*) STR5
      DO 20 I = 1,NAC
   20    READ(11,*) (B(INB(I,J)), J=1,NBC)
      READ(11,*) STR6
      DO 30 I = 1,NAR
   30    READ(11,*) (CRC(INC(I,J)), J=1,NBC)

C  Output matrix data.
      WRITE(12,600) STR1,NAR
      WRITE(12,600) STR2,NAC
      WRITE(12,600) STR3,NBC
      WRITE(12,605) STR4
      DO 40 I = 1,NAR
   40    WRITE(12,610) (A(INA(I,J)), J=1,NAC)
      WRITE(12,605) STR5
      DO 50 I = 1,NAC
   50    WRITE(12,610) (B(INB(I,J)), J=1,NBC)

      CALL MXM(A,NAR,B,NAC,C,NBC)

C  Output new results.
      WRITE(12,605) STR6
      DO 60 I = 1,NAR
   60    WRITE(12,610) (C(INC(I,J)), J=1,NBC)

C  Compare new results to previous results.
      FAILED = .FALSE.
      DO 56 J = 1,NBC
         DO 54 I = 1,NAR
            DIFF = C(INC(I,J)) - CRC(INC(I,J))
            IF (ABS(DIFF) .GE. TOL) FAILED = .TRUE.
   54    CONTINUE
   56 CONTINUE

C  Increment counters.
      IF (FAILED) NFAILS = NFAILS + 1
      NTESTS = NTESTS + 1
  600 FORMAT('''',A10,'''',1X,I4)
  605 FORMAT('''',A10,'''')
  610 FORMAT(5X,2(G21.14,2X),G21.14,:/(10X,G21.14,2X,G21.14,2X,
     &    G21.14))
      RETURN
      END

C-------------------------------------------------------------     ************
C                                                                     DRMXV
C                                                                  ************
      SUBROUTINE DRMXV(NTESTS,NFAILS,TOL)
C
C     Test driver for MXV.
C     Martin J. McBride.  11/8/85.
C     General Electric CRD, Information System Operation.
C
      PARAMETER(MAXA = 400)
      PARAMETER(MAXB = 50)
      CHARACTER*10 STR1,STR2,STR3,STR4,STR5,MESS*5
      LOGICAL FAILED
      INTEGER NTESTS,NFAILS,NAR,NBR,I,J
      DOUBLE PRECISION A,B,C,CRC,TOL,DIFF
      DIMENSION A(MAXA),B(MAXB),C(MAXB),CRC(MAXB)

C  Function to help input matrix A into one-dimensional array A.
      INA(I,J) = NAR*(J-1) + I

C  Input matrix data and previous results.
      READ(11,*) STR1,NAR
      READ(11,*) STR2,NBR
      MESS = 'DRMXV'
      CALL DIMCHECK(NAR*NBR,MAXA,MESS)
      CALL DIMCHECK(NBR,MAXB,MESS)
      CALL DIMCHECK(NAR,MAXB,MESS)
      READ(11,*) STR3
      DO 10 I = 1,NAR
   10    READ(11,*) (A(INA(I,J)), J=1,NBR)
      READ(11,*) STR4
      READ(11,*) (B(I), I=1,NBR)
      READ(11,*) STR5
      READ(11,*) (CRC(I), I=1,NAR)

C  Output matrix data.
      WRITE(12,600) STR1,NAR
      WRITE(12,600) STR2,NBR
      WRITE(12,605) STR3
      DO 20 I = 1,NAR
   20    WRITE(12,610) (A(INA(I,J)), J=1,NBR)
      WRITE(12,605) STR4
      WRITE(12,610) (B(I), I=1,NBR)

      CALL MXV(A,NAR,B,NBR,C)

C  Output new results.
      WRITE(12,605) STR5
      WRITE(12,610) (C(I), I=1,NAR)

C  Compare new results to previous results.
      FAILED = .FALSE.
      DO 30 I = 1,NAR
         DIFF = C(I) - CRC(I)
         IF (ABS(DIFF) .GE. TOL) FAILED = .TRUE.
   30 CONTINUE

C  Increment counters.
      IF (FAILED) NFAILS = NFAILS + 1
      NTESTS = NTESTS + 1
  600 FORMAT('''',A10,'''',1X,I4)
  605 FORMAT('''',A10,'''')
  610 FORMAT(5X,2(G21.14,2X),G21.14,:/(10X,G21.14,2X,G21.14,2X,
     &    G21.14))
      RETURN
      END

C-------------------------------------------------------------     ************
C                                                                     DRMXMA
C                                                                  ************
      SUBROUTINE DRMXMA(NTESTS,NFAILS,TOL)
C
C     Test driver for MXMA.
C     Martin J. McBride.  11/11/85.
C     General Electric CRD, Information System Operation.
C
      PARAMETER(MAX = 625)
      CHARACTER*10 STR1,STR2,STR3,STR4,STR5,STR6,STR7,STR8,STR9
      CHARACTER*6 MESS
      LOGICAL FAILED
      INTEGER NTESTS,NFAILS,NAR,NAC,NBC,I,J
      INTEGER NA,IAD,NB,IBD,NC,ICD,NUMAR,NUMAC,NUMBC
      DOUBLE PRECISION A,B,C,CRC,TOL,DIFF
      DIMENSION A(MAX),B(MAX),C(MAX),CRC(MAX)

C  Functions to help input a matrix into a one-dimensional array.
      INA(I,J) = NUMAR*(J-1) + I
      INB(I,J) = NUMAC*(J-1) + I
      INC(I,J) = NUMAR*(J-1) + I

C  Input matrix data and previous results.
      READ(11,*) STR1,NUMAR
      READ(11,*) STR2,NUMAC
      READ(11,*) STR3,NUMBC
      READ(11,*) STR4,NA,IAD
      READ(11,*) STR5,NB,IBD
      READ(11,*) STR6,NC,ICD
      MESS = 'DRMXMA'
      CALL DIMCHECK(NUMAR*NUMAC,MAX,MESS)
      CALL DIMCHECK(NUMAC*NUMBC,MAX,MESS)
      CALL DIMCHECK(NUMAR*NUMBC,MAX,MESS)
      NAR = NUMAR
      NAC = NUMAC
      NBC = NUMBC
      IF (NA .NE. 0) NAR = (NUMAR + (NA-1))/NA
      IF (IAD .NE. 0) NAC = (NUMAC + (IAD/NUMAR-1))/(IAD/NUMAR)
      IF (IBD .NE. 0) NBC = (NUMBC + (IBD/NUMAC-1))/(IBD/NUMAC)
      READ(11,*) STR7
      DO 10 I = 1,NUMAR
   10    READ(11,*) (A(INA(I,J)), J=1,NUMAC)
      READ(11,*) STR8
      DO 20 I = 1,NUMAC
   20    READ(11,*) (B(INB(I,J)), J=1,NUMBC)
      READ(11,*) STR9
      DO 30 I = 1,NUMAR
   30    READ(11,*) (CRC(INC(I,J)), J=1,NUMBC)

C  Output matrix data.
      WRITE(12,600) STR1,NUMAR
      WRITE(12,600) STR2,NUMAC
      WRITE(12,600) STR3,NUMBC
      WRITE(12,603) STR4,NA,IAD
      WRITE(12,603) STR5,NB,IBD
      WRITE(12,603) STR6,NC,ICD
      WRITE(12,605) STR7
      DO 40 I = 1,NUMAR
   40    WRITE(12,610) (A(INA(I,J)), J=1,NUMAC)
      WRITE(12,605) STR8
      DO 50 I = 1,NUMAC
   50    WRITE(12,610) (B(INB(I,J)), J=1,NUMBC)

C  Initialize matrix C to zeros.
      DO 35 I = 1,NUMAR
         DO 33 J = 1,NUMBC
            C(INC(I,J)) = 0.0
   33    CONTINUE
   35 CONTINUE

      CALL MXMA(A,NA,IAD,B,NB,IBD,C,NC,ICD,NAR,NAC,NBC)

C  Output new results.
      WRITE(12,605) STR9
      DO 60 I = 1,NUMAR
   60    WRITE(12,610) (C(INC(I,J)), J=1,NUMBC)

C  Compare new results to previous results.
      FAILED = .FALSE.
      DO 56 J = 1,NUMBC
         DO 54 I = 1,NUMAR
            DIFF = C(INC(I,J)) - CRC(INC(I,J))
            IF (ABS(DIFF) .GE. TOL) FAILED = .TRUE.
   54    CONTINUE
   56 CONTINUE

C  Increment counters.
      IF (FAILED) NFAILS = NFAILS + 1
      NTESTS = NTESTS + 1
  600 FORMAT('''',A10,'''',1X,I4)
  603 FORMAT('''',A10,'''',1X,2I4)
  605 FORMAT('''',A10,'''')
  610 FORMAT(5X,2(G21.14,2X),G21.14,:/(10X,G21.14,2X,G21.14,2X,
     &    G21.14))
      RETURN
      END

C-------------------------------------------------------------     ************
C                                                                     DRMXVA
C                                                                  ************
      SUBROUTINE DRMXVA(NTESTS,NFAILS,TOL)
C
C     Test driver for MXVA.
C     Martin J. McBride.  11/11/85.
C     General Electric CRD, Information System Operation.
C
      PARAMETER(MAXA = 625)
      PARAMETER(MAXB = 50)
      CHARACTER*10 STR1,STR2,STR3,STR4,STR5,STR6,STR7,MESS*6
      LOGICAL FAILED
      INTEGER NTESTS,NFAILS,NAR,NBR,I,J
      INTEGER NA,IAD,NB,NC,NUMAR,NUMBR
      DOUBLE PRECISION A,B,C,CRC,TOL,DIFF
      DIMENSION A(MAXA),B(MAXB),C(MAXB),CRC(MAXB)

C  Function to help input a matrix into a one-dimensional array.
      INA(I,J) = NUMAR*(J-1) + I

C  Input matrix data and previous results.
      READ(11,*) STR1,NUMAR
      READ(11,*) STR2,NUMBR
      READ(11,*) STR3,NA,IAD
      READ(11,*) STR4,NB,NC
      MESS = 'DRMXVA'
      CALL DIMCHECK(NUMAR*NUMBR,MAXA,MESS)
      CALL DIMCHECK(NUMBR,MAXB,MESS)
      CALL DIMCHECK(NUMAR,MAXB,MESS)
      NAR = NUMAR
      NBR = NUMBR
      IF (NA .NE. 0) NAR = (NUMAR + (NA-1))/NA
      IF (IAD .NE. 0) NBR = (NUMBR + (NB-1))/NB
      READ(11,*) STR5
      DO 10 I = 1,NUMAR
   10    READ(11,*) (A(INA(I,J)), J=1,NUMBR)
      READ(11,*) STR6
      READ(11,*) (B(I), I=1,NUMBR)
      READ(11,*) STR7
      READ(11,*) (CRC(I), I=1,NUMAR)

C  Output matrix data.
      WRITE(12,600) STR1,NUMAR
      WRITE(12,600) STR2,NUMBR
      WRITE(12,603) STR3,NA,IAD
      WRITE(12,603) STR4,NB,NC
      WRITE(12,605) STR5
      DO 20 I = 1,NUMAR
   20    WRITE(12,610) (A(INA(I,J)), J=1,NUMBR)
      WRITE(12,605) STR6
      WRITE(12,610) (B(I), I=1,NUMBR)

C  Initialize vector C to zeros.
      DO 30 I = 1,NUMAR
   30    C(I) = 0.0

      CALL MXVA(A,NA,IAD,B,NB,C,NC,NAR,NBR)

C  Output new results.
      WRITE(12,605) STR7
      WRITE(12,610) (C(I), I=1,NUMAR)

C  Compare new results to old results.
      FAILED = .FALSE.
      DO 40 I = 1,NUMAR
         DIFF = C(I) - CRC(I)
         IF (ABS(DIFF) .GE. TOL) FAILED = .TRUE.
   40 CONTINUE

C  Increment counters.
      IF (FAILED) NFAILS = NFAILS + 1
      NTESTS = NTESTS + 1
  600 FORMAT('''',A10,'''',1X,I4)
  603 FORMAT('''',A10,'''',1X,2I4)
  605 FORMAT('''',A10,'''')
  610 FORMAT(5X,2(G21.14,2X),G21.14,:/(10X,G21.14,2X,G21.14,2X,
     &    G21.14))
      RETURN
      END

C-------------------------------------------------------------     ************
C                                                                     DRMINV
C                                                                  ************
      SUBROUTINE DRMINV(NTESTS,NFAILS,TOL)
C
C     Test driver for MINV.
C     Martin J. McBride.  11/22/85.
C     General Electric CRD, Information System Operation.
C
      PARAMETER(MAXDIM = 25000)
      CHARACTER*10 STR1,STR2,STR3,STR4,STR5,STR6,STR7,MESS*6
      LOGICAL FAILED
      INTEGER NTESTS,NFAILS,M,N,ND,MODE
      DOUBLE PRECISION TOL,AB,SCRATCH,DET,EPS,DIFF
      DIMENSION AB(MAXDIM),CRAB(MAXDIM),SCRATCH(50)
      DATA SCRATCH /50*0.0/

C  Function to help input matrix AB into a one-dimensional array.
      IN(I,J) = ND*(J-1) + I

C  Input matrix data and previous results.
      READ(11,*) STR1,ND
      READ(11,*) STR2,N,M
      MESS = 'DRMINV'
      CALL DIMCHECK(ND*(N+M),MAXDIM,MESS)
      READ(11,*) STR3,MODE
      READ(11,*) STR4,EPS
      READ(11,*) STR5
      DO 10 I = 1,ND
   10    READ(11,*) (AB(IN(I,J)), J=1,N+M)
      READ(11,*) STR6
      DO 20 I = 1,ND
   20    READ(11,*) (CRAB(IN(I,J)), J=1,N+M)
      READ(11,*) STR7,CRDET

C  Output matrix data.
      WRITE(12,600) STR1,ND
      WRITE(12,605) STR2,N,M
      WRITE(12,600) STR3,MODE
      WRITE(12,610) STR4,EPS
      WRITE(12,615) STR5
      DO 30 I = 1,ND
   30    WRITE(12,620) (AB(IN(I,J)), J=1,N+M)

C  Initialize determinant.
      DET = 0.0

      CALL MINV(AB,N,ND,SCRATCH,DET,EPS,M,MODE)

C  Output new results.
      WRITE(12,615) STR6
      DO 40 I = 1,ND
   40    WRITE(12,620) (AB(IN(I,J)), J=1,N+M)
      WRITE(12,610) STR7,DET

C  Compare new results to previous results.
      FAILED = .FALSE.
      LOW = 1
      IF (MODE .EQ. 0) LOW = N + 1
      DO 50 I = 1,ND
         DO 45 J = LOW,N+M
            DIFF = AB(IN(I,J)) - CRAB(IN(I,J))
            IF (ABS(DIFF) .GE. TOL) FAILED = .TRUE.
   45    CONTINUE
   50 CONTINUE
      IF (ABS(DET - CRDET) .GE. TOL) FAILED = .TRUE.

C  Increment counters.
      IF (FAILED) NFAILS = NFAILS + 1
      NTESTS = NTESTS + 1
  600 FORMAT('''',A10,'''',1X,I4)
  605 FORMAT('''',A10,'''',1X,2I4)
  610 FORMAT('''',A10,'''',1X,G21.14)
  615 FORMAT('''',A10,'''')
  620 FORMAT(5X,2(G21.14,2X),G21.14,:/(10X,G21.14,2X,G21.14,2X,
     &    G21.14))
      RETURN
      END

C-------------------------------------------------------------     ************
C                                                                    DIMCHECK
C                                                                  ************
      SUBROUTINE DIMCHECK(NUSED,NALLCTD,MESS)
C
      CHARACTER*(*) MESS
      IF(NUSED.LE.NALLCTD)RETURN
      PRINT *,' DIMENSION FOR ',MESS,' = ',NALLCTD,' EXCEEDED BY ',
     1  NUSED - NALLCTD
      STOP ' SORRY '
      END