      SUBROUTINE MINV(AB,N,LDBA,ZSCRA,DET1,TOL,M,MODE)
      IMPLICIT LOGICAL (L)
      INTEGER N,LDBA,M,MODE
      REAL TOL,DET1
      REAL AB(LDBA,N+M),ZSCRA(  2*N   )
c     internal variables
      REAL RCOND,SCRATCH(  4*N   ),ZMAT(LDBA,N),DET(2),ANORM
      REAL ALPHA,beta,  X(N),Y(LDBA)
      CHARACTER*1        TRANS
      INTEGER IPVT(  N   ),incx, IWORK(N)
      DOUBLE PRECISION DL
      INTEGER, PARAMETER :: N_REAL_KIND=KIND(TOL)

#ifdef DOUBLE_KIND_EQUALS_REAL
      INTEGER, PARAMETER :: N_DOUBLE_KIND=KIND(TOL)
#else
      INTEGER, PARAMETER :: N_DOUBLE_KIND=KIND(DL)
#endif
c
c
      IF (LDBA.NE.N) THEN
           write(6,*)  '  ERROR IN MINV -- Matrix MUST be square'
           CALL ABOR1 ('  ERROR IN MINV -- Matrix MUST be square')
      ENDIF
c
c
      IF (M.LT.0) THEN
           write(6,*)  '  ERROR IN MINV -- M MUST BE >= 0  '
           CALL ABOR1 ('  ERROR IN MINV -- M MUST BE >= 0  ')
      ENDIF
C  
C    Extraction de la matrice ZMAT a factoriser
C  
      DO JL = 1,LDBA
        DO JC = 1,N
          ZMAT(JL,JC) = AB(JL,JC)
        ENDDO
      ENDDO
      CALL GECO
      IF(RCOND.LE.TOL) THEN
          WRITE(6,*)'MINV : MATRIX IS SINGULAR  '
          RETURN
      ENDIF
C  
C    Inversion de ZMAT
C  
      CALL GEDI
C  
      DET1 = DET(1) * 10.0 ** DET(2)
c
C    Remplacement de A (ou ZMAT) par son inverse:
C  
      IF (MODE.NE.0) THEN
      DO JL = 1,LDBA
        DO JC = 1,N
          AB(JL,JC) = ZMAT(JL,JC)
        ENDDO
      ENDDO
      ENDIF
C  
C    Resolution des differents systemes lineaires
C  
      IF (M.GT.0) THEN
      TRANS = 'N'
      alpha = 1.
      beta  = 0.
      incx = 1
      DO ISYS = 1,M
C  
C    Extraction du second membre X
C  
      DO JL = 1,LDBA
          X(JL) = AB(JL,N+ISYS)
      ENDDO
      y = 0.
      IF (N_REAL_KIND == N_DOUBLE_KIND) THEN
        CALL dgemv(trans,ldba,n,alpha,zmat,ldba,x,incx,beta,y,incx)
      ELSE
        CALL sgemv(trans,ldba,n,alpha,zmat,ldba,x,incx,beta,y,incx)
      ENDIF
C  
C    Sauvegarde de la solution
C  
      DO JL = 1,LDBA
         AB(JL,N+ISYS) = y(JL)
      ENDDO
C  
      ENDDO
C  
      ENDIF
C  
c
      RETURN

      CONTAINS
      SUBROUTINE GECO

c--- simulate LINPAC routines SGECO/DGECO using LAPACK

      ANORM= 0.
      DO J = 1, N
        ANORM = MAX(ANORM,SUM(ZMAT(1:N,J)))
      ENDDO

      IF (N_REAL_KIND == N_DOUBLE_KIND) THEN

        CALL DGETRF (N,N,ZMAT,LDBA,IPVT,INFO)
        IF (INFO < 0) THEN
          WRITE(6,*)  'DGETRF RETURNS NEGATIVE INFO: ',INFO
          CALL ABOR1 ('DGETRF RETURNS NEGATIVE INFO')
        ENDIF

        CALL DGECON ('1',N,ZMAT,LDBA,ANORM,RCOND,SCRATCH,IWORK,INFO)
        IF (INFO /= 0) THEN
          WRITE(6,*)  'DGECON RETURNS NON-ZERO INFO: ',INFO
          CALL ABOR1 ('DGECON RETURNS NON-ZERO INFO')
        ENDIF

      ELSE

        CALL SGETRF (N,N,ZMAT,LDBA,IPVT,INFO)
        IF (INFO < 0) THEN
          WRITE(6,*)  'SGETRF RETURNS NEGATIVE INFO: ',INFO
          CALL ABOR1 ('SGETRF RETURNS NEGATIVE INFO')
        ENDIF

        CALL SGECON ('1',N,ZMAT,LDBA,ANORM,RCOND,SCRATCH,IWORK,INFO)
        IF (INFO /= 0) THEN
          WRITE(6,*)  'SGECON RETURNS NON-ZERO INFO: ',INFO
          CALL ABOR1 ('SGECON RETURNS NON-ZERO INFO')
        ENDIF

      ENDIF

      RETURN
      END SUBROUTINE GECO

      SUBROUTINE GEDI

c--- simulate LINPAC routines SGEDI/DGEDI using LAPACK

      DET(1) = 1.0E0
      DET(2) = 0.0E0
      TEN = 10.0E0

      IF (JOB/10 /= 0) THEN
        DETLOOP: DO I = 1, N
          IF (IPVT(I) .NE. I) DET(1) = -DET(1)
          DET(1) = ZMAT(I,I)*DET(1)
          IF (DET(1) .EQ. 0.0E0) EXIT DETLOOP

          DO
          IF (ABS(DET(1)) .GE. 1.0E0) EXIT
            DET(1) = TEN*DET(1)
            DET(2) = DET(2) - 1.0E0
          ENDDO

          DO
          IF (ABS(DET(1)) .LT. TEN) EXIT
            DET(1) = DET(1)/TEN
            DET(2) = DET(2) + 1.0E0
          ENDDO
        ENDDO DETLOOP
      ENDIF

      IF (N_REAL_KIND == N_DOUBLE_KIND) THEN
        CALL DGETRI (N,ZMAT,LDBA,IPVT,SCRATCH,SIZE(SCRATCH),INFO)
        IF (INFO /= 0) THEN
          WRITE(6,*)  'DGETRI RETURNS NON-ZERO INFO: ',INFO
          CALL ABOR1 ('DGETRI RETURNS NON-ZERO INFO')
        ENDIF
      ELSE
        CALL SGETRI (N,ZMAT,LDBA,IPVT,SCRATCH,SIZE(SCRATCH),INFO)
        IF (INFO /= 0) THEN
          WRITE(6,*)  'SGETRI RETURNS NON-ZERO INFO: ',INFO
          CALL ABOR1 ('SGETRI RETURNS NON-ZERO INFO')
        ENDIF
      ENDIF
      
      RETURN
      END SUBROUTINE GEDI

      END SUBROUTINE MINV
