Télécharger invert9.eso

Retour à la liste

Numérotation des lignes :

  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