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 :
© Cast3M 2003 - All rights reserved.
Disclaimer