Télécharger la plaquette Cast3M


fr en

Télécharger invma1.eso

Retour à la liste

Numérotation des lignes : 

invma1

  1. C INVMA1    SOURCE    PV        20/09/15    21:15:06     10713          
  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. -INC CCREEL
  19. C
  20. C   INITIALISATION DES VARIABLES
  21. C
  22.       ISING = 0
  23.  
  24. C  TEST SUR N
  25.  
  26.        IF(N.GT.10) THEN
  27.              ISING = 1
  28.              RETURN
  29.        ENDIF
  30. C
  31.       DO 10 I = 1,N
  32.         IPIV(I)  = 0
  33. * inutile de remettre indxr et indxc a zero
  34. **      INDXR(I) = 0
  35. **      INDXC(I) = 0
  36.   10  CONTINUE
  37. C
  38. C   REDUCTION DES COLONNES ET RECHERCHE DU PIVOT
  39. C
  40.       irow=1
  41.       icol=1
  42.       DO 20 I = 1,N
  43.         BIG = 0.D0
  44.         DO 30 J = 1,N
  45.         IF (IPIV(J).NE.1) THEN
  46.           DO 40 K = 1,N
  47.             IF (IPIV(K).EQ.0) THEN
  48. **            IF (ABS(A(J,K)).GE.BIG) THEN
  49.               IF (.NOT.(ABS(A(J,K)).LT.BIG)) THEN
  50.                 BIG  = ABS(A(J,K))
  51.                 IROW = J
  52.                 ICOL = K
  53.               ENDIF
  54.             ELSEIF (IPIV(K).GT.1) THEN
  55. C
  56. C    LA MATRICE EST SINGULIERE
  57. C
  58.               ISING = 1
  59.               GOTO 95
  60.             ENDIF
  61.   40      CONTINUE
  62.         ENDIF
  63.         IF (.not.(BIG.LT.XGRAND)) then
  64.               ISING = 1
  65.               GOTO 95
  66.         ENDIF
  67.   30    CONTINUE
  68.         IPIV(ICOL) = IPIV(ICOL) + 1
  69. C
  70. C    LE PIVOT A ETE TROUVE
  71. C      => CHANGEMENT DE COLONNE
  72. C
  73.         IF (IROW.NE.ICOL) THEN
  74.           DO 50 L = 1,N
  75.             DUM = A(IROW,L)
  76.             A(IROW,L) = A(ICOL,L)
  77.             A(ICOL,L) = DUM
  78.   50      CONTINUE
  79. C
  80.         ENDIF
  81.         INDXR(I) =IROW
  82.         INDXC(I) = ICOL
  83. C
  84.         IF (A(ICOL,ICOL).EQ.0.D0) THEN
  85. C
  86. C    LA MATRICE EST SINGULIERE
  87. C
  88.           ISING = 1
  89.           GOTO 95
  90.         ENDIF
  91. C
  92.         PIVINV = 1.D0/A(ICOL,ICOL)
  93.         A(ICOL,ICOL) = 1.D0
  94.         DO 60 L = 1,N
  95.            A(ICOL,L) = A(ICOL,L)*PIVINV
  96.   60    CONTINUE
  97. C
  98. C    REDUCTION DES COLONNES
  99. C
  100.         DO 70 LL = 1,N
  101.           IF(LL.NE.ICOL) THEN
  102.             DUM = A(LL,ICOL)
  103.             A(LL,ICOL) = 0.D0
  104.             DO 80 L = 1,N
  105.               A(LL,L) = A(LL,L) - A(ICOL,L)*DUM
  106.   80        CONTINUE
  107.           ENDIF
  108.   70    CONTINUE
  109.   20  CONTINUE
  110. C
  111. C    CHANGEMENT DE COLONNE POUR OBTENIR L INVERSE
  112. C
  113.       DO 91 L = N,1,-1
  114.         IF(INDXR(L).NE.INDXC(L)) THEN
  115.           DO 92 K = 1,N
  116.             DUM = A(K,INDXR(L))
  117.             A(K,INDXR(L)) = A(K,INDXC(L))
  118.             A(K,INDXC(L)) = DUM
  119.   92      CONTINUE
  120.         ENDIF
  121.   91  CONTINUE
  122. C
  123.   95  CONTINUE
  124. C
  125.       END
  126.  
  127.  
  128.  
  129.  
  130.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales