Download iplnu4.eso

Back to the list

   1 : C IPLNU4    SOURCE    CHAT      05/01/13    00:43:43     5004           
   2 :       SUBROUTINE IPLNU4(MA,MB,K)
   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     la matrice a ete decomposé par iplnu3 sous la forme LU
   8 : c
   9 : c variables
  10 : c     a (E)  est un tableau nXn dont les npXnp 1er membre contienne la 
  11 : c        matrice
  12 : c     indx (S) est un tableau de dimension n qui contiendra une tableau
  13 : c          d'indice de permuation
  14 : c     b (E/S) contient en entree le second membre c'est un tableau de
  15 : c        dim n. en sortie il contient la valeurs des inconnues
  16 : c
  17 : c date 18/07/94
  18 : c
  19 : c langage fortran+esope
  20 : c     
  21 :       IMPLICIT INTEGER(I-N)
  22 :       IMPLICIT REAL*8 (A-H,O-Z) 
  23 :       SEGMENT MA 
  24 : *     ce segment contient la matrice du syteme lineaire
  25 : *     a contient les termes et indx contient les indice de permutation
  26 : *     une fois la decomposition effectué  
  27 :          REAL*8 A(NN+1,NN+1),D
  28 :          INTEGER INDX(NN+1)
  29 :       ENDSEGMENT
  30 :       SEGMENT MB 
  31 :          REAL*8 B(NN+1,MM)
  32 :       ENDSEGMENT
  33 :       N = A(/1)
  34 :       II=0
  35 :       DO 12 I=1,N
  36 :         LL=INDX(I)
  37 :         SUM=B(LL,k)
  38 :         B(LL,K)=B(I,K)
  39 :         IF (II.NE.0)THEN
  40 :           DO 11 J=II,I-1
  41 :             SUM=SUM-A(I,J)*B(J,K)
  42 : 11        CONTINUE
  43 :         ELSE IF (SUM.NE.0.) THEN
  44 :           II=I
  45 :         ENDIF
  46 :         B(I,K)=SUM
  47 : 12    CONTINUE
  48 :       DO 14 I=N,1,-1
  49 :         SUM=B(I,K)
  50 :         IF(I.LT.N)THEN
  51 :           DO 13 J=I+1,N
  52 :             SUM=SUM-A(I,J)*B(J,K)
  53 : 13        CONTINUE
  54 :         ENDIF
  55 :         B(I,K)=SUM/A(I,I)
  56 : 14    CONTINUE
  57 :       RETURN
  58 :       END
  59 : 
  60 :  

© Cast3M 2003 - All rights reserved.
Disclaimer