Numérotation des lignes :

invert9
C INVERT9   SOURCE    FANDEUR   13/01/29    21:15:56     7683      SUBROUTINE invert9(A,inv,IDIM) c     idim = dimension of the matrixc     inv  = number of rows and columns of the matrix that will be treatedC      IMPLICIT REAL*8 (A-B,D-H,O-Z)      implicit integer (I-K,M,N)      implicit logical (L)      implicit character*10 (C) C     DECLARATION DES VARIABLESC     -------------------------C      DIMENSION A(IDIM,IDIM),B(9,9) c*    i1 = 1c*    i2 = 2c*    i3 = 3      r0 = 0.0d0      r1 = 1.0d0       if (idim.gt.9) then        write(2,3) idim        write(*,3) idim    3   format(' Error from INVERT9. IDIM =',i3,' should not be greater     . than 9.')        stop      endif       if (inv.gt.9) then        write(2,4) inv        write(*,4) inv    4   format(' Error from INVERT9. INV =',i3,' should not be greater     . than 9.')        stop      endif c     B = matrice identite      do j=1,inv        do i=1,inv          if (i.eq.j) then            b(i,j) = r1          else            b(i,j) = r0          endif        enddo      enddoC                                                                       AMI00090C                                                                       AMI00100C     ELIMINATION DE GAUSS - TRIANGULATION SUPERIEURE                   AMI00110C     -----------------------------------------------                   AMI00120C                                                                       AMI00130      DO K=1,inv-1        IF(A(K,K).eq.r0) THEN          WRITE(2,*)' ERROR IN invert9. K =',K          write(2,*)' PIVOT TROP PETIT : PIVOT =',A(k,k)          write(2,*)' inv =',inv          write(2,*)' idim =',idim          STOP        ENDIF        DO I=K+1,inv          EMIK=A(I,K)/A(K,K)          DO J=K+1,inv            A(I,J)=A(I,J)-EMIK*A(K,J)          ENDDO          DO J=1,inv            B(I,J)=B(I,J)-EMIK*B(K,J)          ENDDO        enddo      enddoC                                                                       AMI00290C                                                                       AMI00300C     SUBSTITUTIONS ARRIERES                                            AMI00310C     ----------------------                                            AMI00320C                                                                       AMI00330      DO K=1,inv        B(inv,K)=B(inv,K)/A(inv,inv)        DO I=1,inv-1          SOMAC=r0          DO J=inv-I+1,inv            SOMAC=SOMAC+A(inv-I,J)*B(J,K)          ENDDO          B(inv-I,K)=(B(inv-I,K)-SOMAC)/A(inv-I,inv-I)        ENDDO      ENDDOC                                                                       AMI00450C                                                                       AMI00460C                                                                       AMI00470      do j=1,inv        do i=1,inv          a(i,j) = b(i,j)        enddo      enddo       RETURN      END   

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