Télécharger elpdr1.eso

Retour à la liste

Numérotation des lignes :

  1. C ELPDR1 SOURCE CHAT 05/01/12 23:37:16 5004
  2. SUBROUTINE ELPDR1(CA1,CV,CX,N,IPIVO,JPIVO,IAUX)
  3. C
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8(A-B,D-H,O-Z)
  6. IMPLICIT COMPLEX*16(C)
  7. C
  8. C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  9. C
  10. C
  11. C RESOLUTION D'UN SYSTEME LINEAIRE COMPLEXE CA1 * CX = CV
  12. C
  13. C PAR LA METHODE DE GAUSS AVEC CALCUL DE LA TRIANGULARISATION
  14. C
  15. C ET STOCKAGE DE CELLE CI DANS LES VECTEURS IPIVO, JPIVO ET IAUX
  16. C
  17. C
  18. C PARAMETRES :
  19. C
  20. C CA1(N*N) : MATRICE (N*N) REPRESENTANT LE SYSTEME LINEAIRE
  21. C CV(N) : SECOND MEMBRE
  22. C IAUX(N) : TABLEAU DE TRAVAIL QUI DONNE L'ORDRE DES INCONNUES
  23. C
  24. C SORTIE :
  25. C
  26. C CX : SOLUTION
  27. C
  28. C AUTEUR : DE LANGRE
  29. C DATE : 08 DEC 1989
  30. C
  31. C ====================================================================
  32. C
  33. COMPLEX*16 CA1(N,*),CV(*),CX(*)
  34. INTEGER IAUX(*),IPIVO(*),JPIVO(*)
  35. EPS = 1.D-12
  36. C
  37. DO 10 I=1,N
  38. IAUX(I) = I
  39. 10 CONTINUE
  40. C 1. TRIANGULARISATION
  41. C BOUCLE SUR LES MATRICES EMBOITEES
  42. C
  43. DO 100 ILIG =1,N
  44. C
  45. C 1.1 RECHERCHE DU PIVOT
  46. C
  47. XPIV =0.D0
  48. IPIV =0
  49. JPIV =0
  50. DO 110 I = ILIG,N
  51. DO 111 J = ILIG,N
  52. IF( ABS ( CA1(I,J)) .GT.XPIV ) THEN
  53. IPIV= I
  54. JPIV= J
  55. XPIV =ABS ( CA1(I,J))
  56. ENDIF
  57. 111 CONTINUE
  58. 110 CONTINUE
  59. C
  60. IPIVO(ILIG) = IPIV
  61. JPIVO(ILIG) = JPIV
  62. C
  63. IF(XPIV .LE.EPS) THEN
  64. WRITE(6,*)'RETURN DANS ELPDR1',XPIV,ILIG
  65. RETURN
  66. ENDIF
  67. C
  68. C 1.2 ON MET LA LIGNE NUMERO IPIV EN ILIG
  69. C ET MEME CHOSE AU SECOND MEMBRE
  70. C
  71. DO 120 J=ILIG,N
  72. CAUX = CA1(IPIV,J)
  73. CA1(IPIV,J)= CA1(ILIG,J)
  74. CA1(ILIG,J)= CAUX
  75. 120 CONTINUE
  76. C
  77. CAUX = CV(IPIV)
  78. CV(IPIV)= CV(ILIG)
  79. CV(ILIG)= CAUX
  80. C
  81. C 1.3 ON MET LA COLONNE NUMERO JPIV EN JLIG= ILIG
  82. C ET ON NOTE CELA DANS LE TABLEAU IAUX
  83. C * ERREUR SUR BORNES 130 CORRIGEE
  84. C
  85. JLIG=ILIG
  86. DO 130 I=1 ,N
  87. CAUX = CA1(I,JPIV)
  88. CA1(I,JPIV)= CA1(I,JLIG)
  89. CA1(I,JLIG)= CAUX
  90. 130 CONTINUE
  91. I0 = IAUX (JPIV)
  92. IAUX(JPIV) = IAUX (JLIG)
  93. IAUX(JLIG) = I0
  94. C
  95. C 1.4 REDUCTION PAR SOUSTRACTION DES LIGNES ENTRE-ELLES
  96. C ET MEME CHOSE AU SECOND MEMBRE
  97. C
  98. DO 140 I= ILIG + 1 ,N
  99. CAUX = CA1(I,ILIG) / CA1(ILIG,ILIG)
  100. DO 141 J=ILIG ,N
  101. CA1(I,J)= CA1(I,J)- CAUX * CA1 (ILIG,J)
  102. 141 CONTINUE
  103. CV(I) = CV(I)- CAUX * CV(ILIG)
  104. 140 CONTINUE
  105. C
  106. C FIN BOUCLE SUR LES MATRICES EMBOITEES
  107. 100 CONTINUE
  108. C
  109. C 2. SUBSTITUTION EN REMONTANT
  110. C
  111. CV(N) = CV(N) / CA1 (N,N)
  112. DO 200 I= 2,N
  113. IN = N + 1 - I
  114. DO 210 K= 1,I-1
  115. KN = N + 1 - K
  116. CV(IN) = CV(IN) - CA1 (IN,KN)* CV(KN)
  117. 210 CONTINUE
  118. CV(IN) = CV(IN) / CA1 (IN,IN)
  119. 200 CONTINUE
  120. C
  121. C 3. ON REMET LES INCONNUES A LA BONNE PLACE
  122. C
  123. DO 300 I= 1,N
  124. CX(IAUX(I)) = CV(I)
  125. 300 CONTINUE
  126. C
  127. RETURN
  128. END
  129.  
  130.  

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