Télécharger la plaquette Cast3M


fr en

Télécharger iplnu3.eso

Retour à la liste

Numérotation des lignes : 

iplnu3

  1. C IPLNU3    SOURCE    BP208322  21/01/28    21:15:12     10868          
  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.  
  120.  

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