


      SUBROUTINE MatTxTiX (aryin, numrow, numcol, aryout)
      INCLUDE 'STDHDR.FOR'
      REAL aryin(0:maxr,0:maxc), aryout(0:maxc,0:maxc)
      INTEGER numrow, numcol,i, j, k

      DO i = 0, numcol - 1
        DO j = 0, numcol - 1
          aryout(i, j) = 0.0
          DO k = 0, numrow - 1
            aryout(i, j) = aryout(i, j) + aryin(k, j) * aryin(k, i)
          END DO
        END DO
      END DO
      END ! MatTxTiX



      SUBROUTINE MatYTiX (aryy, aryx, numrow, numcol, aryout)
      INCLUDE 'STDHDR.FOR'
      REAL aryy(0:maxr), aryx(0:maxr,0:maxc), aryout(0:maxc)
      INTEGER numrow, numcol,i, k

      DO i = 0, numcol - 1
        aryout(i) = 0.0
        DO k = 0, numrow - 1
          aryout(i) = aryout(i) + aryy(k) * aryx(k, i)
        END DO
      END DO
      END !SUB  MatYtiX



      SUBROUTINE MultipleReg (indvardat, depvardat, numiv,
     +  numobs, regcoef, yest, resid, see, coefsig, rsq, r, regerror)
       INCLUDE 'STDHDR.FOR'
      REAL indvardat(0:maxr,0:maxc),depvardat(0:maxr), regcoef(0:maxc)
      REAL yest(0:maxr), resid(0:maxr), coefsig(0:maxc),see,r,rsq

      REAL regmat[ALLOCATABLE](:,:), aryinv[ALLOCATABLE](:,:)
      REAL arya[ALLOCATABLE](:,:), aryg[ALLOCATABLE](:)
      INTEGER numiv, numobs,i, j, numcol, iErr
      LOGICAL regerror

      ALLOCATE(regmat(0:maxr, 0:maxc), aryinv(0:maxc, 0:maxc),STAT=iErr)
      CALL CheckMem(iErr)
      ALLOCATE(arya(0:maxc, 0:maxc), aryg(0:maxc), STAT = iErr)
      CALL CheckMem(iErr)

      DO i = 0, numobs - 1
        DO j = 0, numiv - 1
          regmat(i, j + 1) = indvardat(i, j)
        END DO
        regmat(i, 0) = 1.0
      END DO

      numcol = numiv + 1

      CALL MatTxTiX(regmat, numobs, numcol, arya)

      CALL MatYTiX(depvardat, regmat, numobs, numcol, aryg)

      CALL GaussJordan(arya, aryg, numcol, regcoef, aryinv, regdet)

      CALL ResAnalysis(regmat, depvardat, regcoef, aryinv, numobs,
     + numcol, yest, resid, see, coefsig, rsq, r)

      IF (regdet .LT. .0000001) THEN
        regerror = .TRUE.
      ELSE
        regerror = .FALSE.
      END IF

      DEALLOCATE(regmat,STAT=iErr)
      CALL CheckMem(iErr)
      DEALLOCATE(aryinv,STAT=iErr)
      CALL CheckMem(iErr)
      DEALLOCATE(arya,STAT=iErr)
      CALL CheckMem(iErr)
      DEALLOCATE(aryg,STAT=iErr)
      CALL CheckMem(iErr)

      END !SUB   MultipleReg






      SUBROUTINE ResAnalysis (regmat, ymat, regcoef,
     + aryinv, numrow, numcol, yest, resid, see, coefsig, rsq, r)
      INCLUDE 'STDHDR.FOR'
      REAL regmat(0:maxr, 0:maxc), ymat(0:maxr), regcoef(0:maxc)
      REAL aryinv(0:maxc, 0:maxc), yest(0:maxr), resid(0:maxr)
      REAL coefsig(0:maxc), see,rsq, r, sumressq, sumy, sumysq
      INTEGER numrow, numcol,i, j, nxx


      sumressq = 0.0
      sumy = 0.0
      sumysq = 0.0
      DO i = 0, numrow - 1
        yest(i) = 0.0
        DO j = 0, numcol - 1
          yest(i) = yest(i) + regcoef(j) * regmat(i, j)
        END DO
        resid(i) = yest(i) - ymat(i)
        sumressq = sumressq + resid(i)**2
        sumy = sumy + ymat(i)
        sumysq = sumysq + ymat(i)**2
      END DO
      IF (numrow .EQ. numcol) THEN
        nxx = 1
      ELSE
        nxx = numrow - numcol
      END IF
      see = SQRT(sumressq / REAL(nxx))
      DO i = 0, numcol - 1
        coefsig(i) = see * SQRT(aryinv(i, i))
      END DO
      rsq = (1.0 - sumressq / (sumysq - sumy ** 2 / REAL(numrow)))
      r = SQRT(rsq)
      END !SUB ResAnalysis




! 5/2/90 modified MultipleRec to correctly deallocate all arrays