Esope source files

   1 : C INVMA1    SOURCE    AM        09/12/08    21:15:21     6582           
   2 :       SUBROUTINE INVMA1(A,NDI,N,ISING)
   3 : C
   4 : C_______________________________________________________________________
   5 : C
   6 : C SOUS PROGRAMME QUI CALCUL L INVERSE D UNE MATRICE CARRE D ORDRE N
   7 : C
   8 : C  LA METHODE DE GAUSS JORDAN EST UTILISE
   9 : C
  10 : C   ISING = 1 SI LA MATRICE EST SINGULIERE
  11 : C         = 0 SINON
  12 : C_______________________________________________________________________
  13 : C
  14 :       IMPLICIT INTEGER(I-N)
  15 :       IMPLICIT REAL*8(A-H,O-Z)
  16 :       DIMENSION A(NDI,*)
  17 :       DIMENSION IPIV(10),INDXR(10),INDXC(10)
  18 : C
  19 : C   INITIALISATION DES VARIABLES
  20 : C
  21 :       ISING = 0
  22 : 
  23 : C  TEST SUR N
  24 : 
  25 :        IF(N.GT.10) THEN
  26 :              ISING = 1
  27 :              RETURN
  28 :        ENDIF
  29 : C
  30 :       DO 10 I = 1,N
  31 :         IPIV(I)  = 0
  32 :         INDXR(I) = 0
  33 :         INDXC(I) = 0
  34 :   10  CONTINUE
  35 : C
  36 : C   REDUCTION DES COLONNES ET RECHERCHE DU PIVOT
  37 : C
  38 :       DO 20 I = 1,N
  39 :         BIG = 0.D0
  40 :         DO 30 J = 1,N
  41 :         IF (IPIV(J).NE.1) THEN
  42 :           DO 40 K = 1,N
  43 :             IF (IPIV(K).EQ.0) THEN
  44 :               IF (ABS(A(J,K)).GE.BIG) THEN
  45 :                 BIG  = ABS(A(J,K))
  46 :                 IROW = J
  47 :                 ICOL = K
  48 :               ENDIF
  49 :             ELSEIF (IPIV(K).GT.1) THEN
  50 : C
  51 : C    LA MATRICE EST SINGULIERE
  52 : C
  53 :               ISING = 1
  54 :               GOTO 95
  55 :             ENDIF
  56 :   40      CONTINUE
  57 :         ENDIF
  58 :   30    CONTINUE
  59 :         IPIV(ICOL) = IPIV(ICOL) + 1
  60 : C
  61 : C    LE PIVOT A ETE TROUVE
  62 : C      => CHANGEMENT DE COLONNE
  63 : C
  64 :         IF (IROW.NE.ICOL) THEN
  65 :           DO 50 L = 1,N
  66 :             DUM = A(IROW,L)
  67 :             A(IROW,L) = A(ICOL,L)
  68 :             A(ICOL,L) = DUM
  69 :   50      CONTINUE
  70 : C
  71 :         ENDIF
  72 :         INDXR(I) =IROW
  73 :         INDXC(I) = ICOL
  74 : C
  75 :         IF (A(ICOL,ICOL).EQ.0.D0) THEN
  76 : C
  77 : C    LA MATRICE EST SINGULIERE
  78 : C
  79 :           ISING = 1
  80 :           GOTO 95
  81 :         ENDIF
  82 : C
  83 :         PIVINV = 1.D0/A(ICOL,ICOL)
  84 :         A(ICOL,ICOL) = 1.D0
  85 :         DO 60 L = 1,N
  86 :            A(ICOL,L) = A(ICOL,L)*PIVINV
  87 :   60    CONTINUE
  88 : C
  89 : C    REDUCTION DES COLONNES
  90 : C
  91 :         DO 70 LL = 1,N
  92 :           IF(LL.NE.ICOL) THEN
  93 :             DUM = A(LL,ICOL)
  94 :             A(LL,ICOL) = 0.D0
  95 :             DO 80 L = 1,N
  96 :               A(LL,L) = A(LL,L) - A(ICOL,L)*DUM
  97 :   80        CONTINUE
  98 :           ENDIF
  99 :   70    CONTINUE
 100 :   20  CONTINUE
 101 : C
 102 : C    CHANGEMENT DE COLONNE POUR OBTENIR L INVERSE
 103 : C
 104 :       DO 91 L = N,1,-1
 105 :         IF(INDXR(L).NE.INDXC(L)) THEN
 106 :           DO 92 K = 1,N
 107 :             DUM = A(K,INDXR(L))
 108 :             A(K,INDXR(L)) = A(K,INDXC(L))
 109 :             A(K,INDXC(L)) = DUM
 110 :   92      CONTINUE
 111 :         ENDIF
 112 :   91  CONTINUE
 113 : C
 114 :   95  CONTINUE
 115 : C
 116 :       END
 117 :  
 118 :