End of file
Contents
Index



F 4.9 The Matrix Inverse via Exchange Steps


      SUBROUTINE PIVOT (A,LDA,N,B,S1,S2,IERR,MX,MY,VAL)
C
C*****************************************************************
C                                                                *
C  This subroutine calculates the inverse of a real square NxN   *
C  matrix  A  by applying exchange steps, also called the method *
C  of pivotization.                                              *
C                                                                *
C                                                                *
C  INPUT PARAMETERS:                                             *
C  =================                                             *
C  A        : 2-dimensional array A(1:LDA,1:N) containing the    *
C             matrix A that is to be inverted.                   *
C  LDA      : leading dimension of A as defined in the calling   *
C             program.                                           *
C  N        : order of the matrix A.                             *
C                                                                *
C                                                                *
C  OUTPUT PARAMETERS:                                            *
C  ==================                                            *
C  B        : 2-dimensional array B(1:LDA,1:N) containing the    *
C             inverse matrix of A.                               *
C  S1,S2    : control parameters;  S1 is the sum of the absolute *
C             values of the diagonal entries of the matrix A*B-I,*
C             where I is the nxn identity matrix.                *
C             S2 is the sum of the absolute values of the off-   *
C             diagonal entries in A*B-I. Theoretically A*B-I = 0.*
C  IERR     : = 1, inverse of A has been found.                  *
C             = 2, the matrix A is numerically singular, no      *
C                  inverse exists.                               *
C  VAL      : last pivot element, if A is numerically singular.  *
C                                                                *
C                                                                *
C  AUXILIARY VECTORS:                                            *
C  ==================                                            *
C  MX,MY    : N-vectors of INTEGER type.                         *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C  subroutines required: MACHPD                                  *
C                                                                *
C*****************************************************************
C                                                                *
C  author     : Gisela Engeln-Muellges                           *
C  date       : 05.18.1987                                       *
C  source     : FORTRAN 77                                       *
C                                                                *
C*****************************************************************
C
C  declarations.
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DOUBLE PRECISION A(LDA,N),B(LDA,N)
      INTEGER MX(N),MY(N)
C
C  calculating the machine constant FMACHP.
C
      FMACHP=1.0D0
    5 FMACHP=0.5D0*FMACHP
      IF(MACHPD(1.0D0+FMACHP) .EQ. 1) GOTO 5
      FMACHP=FMACHP*2.0D0
C
C  store matrix A in array B.
C
      DO 10 I=1,N
         DO 20 J=1,N
            B(I,J)=A(I,J)
   20    CONTINUE
   10 CONTINUE
C
C  initialize the pivot vectors MX and MY to zero.
C
      DO 30 I=1,N
         MX(I)=0
         MY(I)=0
   30 CONTINUE
C
C  determine the pivot element.
C
      DO 40 I=1,N
         PIVO=0.0D0
         DO 50 IX=1,N
            IF(MX(IX) .EQ. 0) THEN
               DO 60 IY=1,N
                  IF(MY(IY) .EQ. 0) THEN
                     IF(DABS(B(IX,IY)) .GT. DABS(PIVO)) THEN
                        PIVO=B(IX,IY)
                        NX=IX
                        NY=IY
                     END IF
                  END IF
   60          CONTINUE
            END IF
   50    CONTINUE
C
C  if the pivot element is nearly zero, the matrix is numerically singular.
C
         IF(DABS(PIVO) .LT. 4.0D0*FMACHP) THEN
            VAL=PIVO
            IERR=2
            RETURN
         END IF
C
C  saving the indices of the pivot element.
C
         MX(NX)=NY
         MY(NY)=NX
C
C  calculation of the matrix elements according to the
C  rules for an exchange step.
C
         DUMMY=1.0D0/PIVO
         DO 70 J=1,N
            IF(J .NE. NX) THEN
               FACTOR=B(J,NY)*DUMMY
               DO 80 K=1,N
                  B(J,K)=B(J,K)-B(NX,K)*FACTOR
   80          CONTINUE
               B(J,NY)=-FACTOR
            END IF
   70    CONTINUE
         DO 90 K=1,N
            B(NX,K)=B(NX,K)*DUMMY
   90    CONTINUE
         B(NX,NY)=DUMMY
   40 CONTINUE
C
C  reverse row and column permutations.
C
      DO 100 I=1,N-1
         DO 110 M=I,N
            IF(MX(M) .EQ. I) GOTO 120
  110    CONTINUE
  120    J=M
         IF(J .NE. I) THEN
            DO 130 K=1,N
               H=B(I,K)
               B(I,K)=B(J,K)
               B(J,K)=H
  130       CONTINUE
            MX(J)=MX(I)
            MX(I)=I
         END IF
         DO 140 M=I,N
            IF(MY(M) .EQ. I) GOTO 150
  140    CONTINUE
  150    J=M
         IF(J .NE. I) THEN
            DO 160 K=1,N
               H=B(K,I)
               B(K,I)=B(K,J)
               B(K,J)=H
  160       CONTINUE
            MY(J)=MY(I)
            MY(I)=I
         END IF
  100 CONTINUE
C
C  Forming the difference S= A*B-I, where I is the identity matrix.
C  Forming the sum S1 of the absolute values of the diagonal elements of S
C  and the sum S2 of remaining elements. Theoretically
C  S1 and S2 should both equal zero.
C
      S1=0.0D0
      S2=0.0D0
      DO 170 I=1,N
         DO 180 J=1,N
            H=0.0D0
            DO 190 K=1,N
               H=H+A(I,K)*B(K,J)
  190       CONTINUE
            IF(I .EQ. J) THEN
               S1=S1+DABS(H-1.0D0)
            ELSE
               S2=S2+DABS(H)
            END IF
  180    CONTINUE
  170 CONTINUE
      IERR=1
      RETURN
      END


Begin of file
Contents
Index