Télécharger la plaquette Cast3M


fr en

Télécharger invert9.eso

Retour à la liste

Numérotation des lignes : 

invert9

  1. C INVERT9   SOURCE    FANDEUR   13/01/29    21:15:56     7683
  2.       SUBROUTINE invert9(A,inv,IDIM)
  3.  
  4. c     idim = dimension of the matrix
  5. c     inv  = number of rows and columns of the matrix that will be treated
  6. C
  7.       IMPLICIT REAL*8 (A-B,D-H,O-Z)
  8.       implicit integer (I-K,M,N)
  9.       implicit logical (L)
  10.       implicit character*10 (C)
  11.  
  12. C     DECLARATION DES VARIABLES
  13. C     -------------------------
  14. C
  15.       DIMENSION A(IDIM,IDIM),B(9,9)
  16.  
  17. c*    i1 = 1
  18. c*    i2 = 2
  19. c*    i3 = 3
  20.       r0 = 0.0d0
  21.       r1 = 1.0d0
  22.  
  23.       if (idim.gt.9) then
  24.         write(2,3) idim
  25.         write(*,3) idim
  26.     3   format(' Error from INVERT9. IDIM =',i3,' should not be greater
  27.      . than 9.')
  28.         stop
  29.       endif
  30.  
  31.       if (inv.gt.9) then
  32.         write(2,4) inv
  33.         write(*,4) inv
  34.     4   format(' Error from INVERT9. INV =',i3,' should not be greater
  35.      . than 9.')
  36.         stop
  37.       endif
  38.  
  39. c     B = matrice identite
  40.       do j=1,inv
  41.         do i=1,inv
  42.           if (i.eq.j) then
  43.             b(i,j) = r1
  44.           else
  45.             b(i,j) = r0
  46.           endif
  47.         enddo
  48.       enddo
  49. C                                                                       AMI00090
  50. C                                                                       AMI00100
  51. C     ELIMINATION DE GAUSS - TRIANGULATION SUPERIEURE                   AMI00110
  52. C     -----------------------------------------------                   AMI00120
  53. C                                                                       AMI00130
  54.       DO K=1,inv-1
  55.         IF(A(K,K).eq.r0) THEN
  56.           WRITE(2,*)' ERROR IN invert9. K =',K
  57.           write(2,*)' PIVOT TROP PETIT : PIVOT =',A(k,k)
  58.           write(2,*)' inv =',inv
  59.           write(2,*)' idim =',idim
  60.           STOP
  61.         ENDIF
  62.         DO I=K+1,inv
  63.           EMIK=A(I,K)/A(K,K)
  64.           DO J=K+1,inv
  65.             A(I,J)=A(I,J)-EMIK*A(K,J)
  66.           ENDDO
  67.           DO J=1,inv
  68.             B(I,J)=B(I,J)-EMIK*B(K,J)
  69.           ENDDO
  70.         enddo
  71.       enddo
  72. C                                                                       AMI00290
  73. C                                                                       AMI00300
  74. C     SUBSTITUTIONS ARRIERES                                            AMI00310
  75. C     ----------------------                                            AMI00320
  76. C                                                                       AMI00330
  77.       DO K=1,inv
  78.         B(inv,K)=B(inv,K)/A(inv,inv)
  79.         DO I=1,inv-1
  80.           SOMAC=r0
  81.           DO J=inv-I+1,inv
  82.             SOMAC=SOMAC+A(inv-I,J)*B(J,K)
  83.           ENDDO
  84.           B(inv-I,K)=(B(inv-I,K)-SOMAC)/A(inv-I,inv-I)
  85.         ENDDO
  86.       ENDDO
  87. C                                                                       AMI00450
  88. C                                                                       AMI00460
  89. C                                                                       AMI00470
  90.       do j=1,inv
  91.         do i=1,inv
  92.           a(i,j) = b(i,j)
  93.         enddo
  94.       enddo
  95.  
  96.       RETURN
  97.       END
  98.  
  99.  
  100.  

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