Télécharger la plaquette Cast3M


fr en

Télécharger inver.eso

Retour à la liste

Numérotation des lignes : 

inver

  1. C INVER     SOURCE    CHAT      05/01/13    00:42:48     5004
  2.       SUBROUTINE INVER(A,NZ,ICRIT,B,IS,EPS)
  3. C
  4. C  ====================================================================
  5. C    SOUS-PROGRAMME FORTRAN APPELE PAR ELFINV
  6. C    INVERSION DE MATRICE PAR RESOLUTION SUCCESSIVE DE NZ SYSTEMES
  7. C    LINEAIRES
  8. C    A  MATRICE (NZ*NZ) A INVERSER EN ENTREE, MATRICE INVERSEE EN SORTIE
  9. C    ICRIT=1 SI MATRICE SINGULIERE, 0 SINON
  10. C    B  TABLEAU DE REELS DE DIMENSION NZ*NZ
  11. C    IS  TABLEAU D'ENTIERS DE DIMENSION NZ
  12. C    EPS PRECISION
  13. C  ====================================================================
  14. C
  15.       IMPLICIT INTEGER(I-N)
  16.       IMPLICIT REAL*8(A-H,O-Z)
  17.  
  18. -INC PPARAM
  19. -INC CCOPTIO
  20.       DIMENSION A(NZ,1),B(NZ,1)
  21.       DIMENSION IS(1)
  22. C
  23. C      INITIALISATIONS
  24. C      IS SUITE REPRESENTANT L'INDICE J DE X(J) SOLU CORRESPONDANT
  25. C      A LA I EME COLONNE DE LA MATRICE A TRIANGULARISEE
  26. C
  27.       DO 20 I=1,NZ
  28.          DO 10 J=1,NZ
  29.          B(J,I)=0.D0
  30.   10     CONTINUE
  31.       B(I,I)=1.D0
  32.       IS(I)=I
  33.   20  CONTINUE
  34.       ICRIT=0
  35. C
  36. C  1-  TRIANGULARISATION
  37. C
  38.       NZM1=NZ-1
  39.       DO 100 NR=1,NZM1
  40. C
  41. C      CHOIX DU PIVOT
  42. C
  43.       PIVOT=0.D0
  44.       DO 40 K=NR,NZ
  45.       DO 40 L=NR,NZ
  46.       ABSKL=ABS(A(K,L))
  47.       IF(ABSKL.GT.PIVOT) THEN
  48.         I=K
  49.         J=L
  50.         PIVOT=ABSKL
  51.       ENDIF
  52.   40  CONTINUE
  53. C
  54. C     LE PIVOT EST-IL NUL?
  55. C
  56.       IF(PIVOT.LE.EPS) THEN
  57.            ICRIT=1
  58.            RETURN
  59.       ENDIF
  60. C
  61. C      CHANGEMENT DE LIGNE : PLACE LE PIVOT EN NR EME LIGNE
  62. C
  63.       DO 50 L=1,NZ
  64.       D   =A(NR,L)
  65.       A(NR,L)=A(I,L)
  66.       A(I,L)=D
  67.    50 CONTINUE
  68.       DO 60 L=1,NZ
  69.       E=B(NR,L)
  70.       B(NR,L)=B(I,L)
  71.       B(I,L)=E
  72.    60 CONTINUE
  73. C
  74. C      CHANGEMENT DE COLONNE : PLACE LE PIVOT EN R EME COLONNE
  75. C
  76.       DO 70 M=1,NZ
  77.       CC  =A(M,NR)
  78.       A(M,NR)=A(M,J)
  79.       A(M,J)=CC
  80.    70 CONTINUE
  81. C
  82. C      INDICE DES VARIABLES CORRESPONDANT A LA J EME ET A LA R EME COLON
  83. C
  84.       ISR=IS(NR)
  85.       IS(NR)=IS(J)
  86.       IS(J)=ISR
  87. C
  88. C      CALCUL DE LA NOUVELLE MATRICE A
  89. C
  90.       NRP1=NR+1
  91.       DO 90 I=NRP1,NZ
  92.       IF(A(I,NR).NE.0.D0)THEN
  93.         G=A(I,NR)/A(NR,NR)
  94.         DO 80 J=1,NZ
  95.         A(I,J)=A(I,J)-G*A(NR,J)
  96.         B(I,J)=B(I,J)-G*B(NR,J)
  97.    80   CONTINUE
  98.       ENDIF
  99.    90 CONTINUE
  100.   100 CONTINUE
  101. C
  102. C  2-  RESOLUTION DU SYSTEME TRIANGULARISE
  103. C
  104.       DO 130 J=1,NZ
  105.       B(NZ,J)=B(NZ,J)/A(NZ,NZ)
  106.          DO 120 I= NZM1,1,-1
  107.          F=0.D0
  108.          I1=I+1
  109.             DO 110 JJ=I1,NZ
  110.             F=F-A(I,JJ)*B(JJ,J)
  111.   110       CONTINUE
  112.          B(I,J)=(B(I,J)+F)/A(I,I)
  113.   120    CONTINUE
  114.   130 CONTINUE
  115. C
  116.       DO 140 L=1,NZ
  117.       IL=IS(L)
  118.       DO 140 J=1,NZ
  119.       A(IL,J)=B(L,J)
  120.   140 CONTINUE
  121.       RETURN
  122.       END
  123.  
  124.  

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