Télécharger iplnu3.eso

Retour à la liste

Numérotation des lignes :

  1. C IPLNU3 SOURCE CB215821 15/04/10 21:15:17 8473
  2. SUBROUTINE IPLNU3(A,D,INDX,ILONG)
  3. c
  4. c fonction
  5. c Cette routine sert à resoudre un systeme lineaire non symmetrqiue
  6. c par la methode LU ( cf Numerical recipes in fortran 2nd edition)
  7. c
  8. c variables (E:entrée / S:sortie)
  9. c a (E/S) est un tableau nXn dont les npXnp 1er membre contienne la
  10. c matrice. A la sortie a est sous la forme LU
  11. c indx (S) est un tableau de dimension n qui contiendra une tableau
  12. c d'indice de permuation
  13. c
  14. c d (S) est la signature de la permutation stockee dans indx (-/+1)
  15. c
  16. c date 18/07/94
  17. c
  18. c langage fortran pur
  19. c
  20. IMPLICIT INTEGER(I-N)
  21. IMPLICIT REAL*8(A-H,O-Z)
  22. PARAMETER (TINY=1.0D-20)
  23.  
  24. C SEGMENT MA
  25. C ce segment contient la matrice du syteme lineaire
  26. C a contient les termes et indx contient les indice de permutation
  27. C une fois la decomposition effectué
  28. REAL*8 A,D
  29. INTEGER INDX
  30. DIMENSION A(ILONG,*)
  31. DIMENSION INDX(*)
  32. C ENDSEGMENT
  33.  
  34. C SEGMENT MV
  35. REAL*8 VV(ILONG)
  36. C ENDSEGMENT
  37.  
  38. C WRITE(6,*)'Dans iplnu3 ILONG',ILONG
  39.  
  40. C SEGACT,MA*MOD
  41. N = ILONG
  42. C NN = N-1
  43. C SEGINI MV
  44. D=1.D0
  45. DO 12 I=1,N
  46. AAMAX=0.D0
  47. DO 11 J=1,N
  48. C WRITE(6,*)'Dans iplnu3 I,J,A(I,J)',I,J,A(I,J)
  49. IF (ABS(A(I,J)).GT.AAMAX) AAMAX=ABS(A(I,J))
  50. 11 CONTINUE
  51. IF (AAMAX.EQ.0.) THEN
  52. c la matrice contient une colonne de termes nuls
  53. CALL ERREUR(-292)
  54. AAMAX = TINY
  55. ENDIF
  56. VV(I)=1.D0/AAMAX
  57. 12 CONTINUE
  58. DO 19 J=1,N
  59. IF (J.GT.1) THEN
  60. DO 14 I=1,J-1
  61. SUM=A(I,J)
  62. IF (I.GT.1)THEN
  63. DO 13 K=1,I-1
  64. SUM=SUM-A(I,K)*A(K,J)
  65. 13 CONTINUE
  66. A(I,J)=SUM
  67. ENDIF
  68. 14 CONTINUE
  69. ENDIF
  70. AAMAX=0.D0
  71. DO 16 I=J,N
  72. SUM=A(I,J)
  73. IF (J.GT.1)THEN
  74. DO 15 K=1,J-1
  75. SUM=SUM-A(I,K)*A(K,J)
  76. 15 CONTINUE
  77. A(I,J)=SUM
  78. ENDIF
  79. DUM=VV(I)*ABS(SUM)
  80. IF (DUM.GE.AAMAX) THEN
  81. IMAX=I
  82. AAMAX=DUM
  83. ENDIF
  84. 16 CONTINUE
  85. IF (J.NE.IMAX)THEN
  86. DO 17 K=1,N
  87. DUM=A(IMAX,K)
  88. A(IMAX,K)=A(J,K)
  89. A(J,K)=DUM
  90. 17 CONTINUE
  91. D=-D
  92. VV(IMAX)=VV(J)
  93. ENDIF
  94. INDX(J)=IMAX
  95. IF(J.NE.N)THEN
  96. IF(A(J,J).EQ. 0.D0) THEN
  97. C & 'Nuage pathologique pour la méthode d interpolation'
  98. C matrice singulière dans l'algorithme d'interpolation
  99. A(J,J)=TINY
  100. CALL ERREUR(-292)
  101. ENDIF
  102. DUM=1.D0/A(J,J)
  103. DO 18 I=J+1,N
  104. A(I,J)=A(I,J)*DUM
  105. 18 CONTINUE
  106. ENDIF
  107. 19 CONTINUE
  108. IF(A(N,N).EQ. 0.D0) THEN
  109. C & 'Nuage pathologique pour la méthode d interpolation'
  110. C matrice singulière dans l'algorithme d'interpolation
  111. CALL ERREUR(-292)
  112. A(N,N)=TINY
  113. ENDIF
  114. C SEGSUP MV
  115. RETURN
  116. END
  117.  
  118.  
  119.  

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