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 :
© Cast3M 2003 - All rights reserved.
Disclaimer