1 : C VALPR2 SOURCE CHAT 09/11/25 21:15:32 6548 2 : SUBROUTINE VALPR2 (DIAG,NTERME,SSDIAG,NBITER,PRECI1,PRECI2) 3 : implicit real*8(a-H,o-Z) 4 : ************************************************************************ 5 : * 6 : * V A L P R 2 7 : * ----------- 8 : * 9 : * FONCTION: 10 : * --------- 11 : * 12 : * CALCULER LES VALEURS PROPRES D'UNE MATRICE TRIDIAGONALE DE LA 13 : * FORME: 14 : * 15 : * | A1 1 0 0 0 0 | 16 : * | B1 A2 1 0 0 0 | 17 : * | 0 B2 A3 1 0 0 | 18 : * | 0 0 B3 A4 1 0 | 19 : * | 0 0 0 B4 A5 1 | 20 : * | 0 0 0 0 B5 A6 | 21 : * 22 : * PAR "ITERATIONS L.R" 23 : * 24 : * MODE D'APPEL: 25 : * ------------- 26 : * 26 : * CALL VALPR2 (DIAG,NTERME,SSDIAG,NBITER,PRECI1,PRECI2) 27 : * 28 : * PARAMETRES: (E)=ENTREE (S)=SORTIE 29 : * ----------- 30 : * 31 : * DIAG REEL DP (E) LISTE DES TERMES DIAGONAUX DE LA MATRICE. 32 : * (S) LISTE DES VALEURS PROPRES DE LA MATRICE. 33 : * NTERME ENTIER (E) DIMENSION DE LA MATRICE (CARREE). 34 : * SSDIAG REEL DP (E) LISTE DES TERMES DE LA SOUS-DIAGONALE DE LA 35 : * MATRICE. 36 : * (S) LA LISTE D'ENTREE EST DETRUITE. ON TROUVE A 37 : * LA PLACE LES NOMBRES QUI ONT ETE COMPARES A 38 : * "0" DANS LE TEST DE CONVERGENCE, POUR 39 : * CHAQUE VALEUR PROPRE. 40 : * NBITER ENTIER (E) NOMBRE D'ITERATIONS PERMISES PAR VALEUR 41 : * PROPRE. 42 : * PRECI1 REEL DP (E) PRECISION ABSOLUE DE CONVERGENCE. 43 : * = 0 SI LE TEST DOIT SE FAIRE AVEC "PRECI2" 44 : * PRECI2 REEL DP (E) PRECISION RELATIVE DE CONVERGENCE. 45 : * = 0 SI LE TEST DOIT SE FAIRE AVEC "PRECI1" 46 : * 47 : * LEXIQUE: (ORDRE ALPHABETIQUE) 48 : * -------- 49 : * 50 : * DIAG REEL DP CONTIENT ALTERNATIVEMENT LES TERMES DIAGONAUX DE 51 : * "T" ET LES TERMES DIAGONAUX DE "R". 52 : * NRESTE ENTIER DIMENSION DE LA MATRICE TRIDIAGONALE EXTRAITE 53 : * (DEFINIE AU PARAGRAPHE "MODE DE FONCTIONNEMENT") 54 : * SSDIAG REEL DP CONTIENT ALTERNATIVEMENT LES TERMES 55 : * SOUS-DIAGONAUX DE "T" ET CEUX DE "L". 56 : * 57 : * LES NOTATIONS "T", "R" ET "L" SONT DEFINIES AU PARAGRAPHE "MODE DE 58 : * FONCTIONNEMENT". 59 : * 60 : * MODE DE FONCTIONNEMENT: 61 : * ----------------------- 62 : * 63 : * PRINCIPE DES "ITERATIONS L.R": 64 : * 65 : * EN REPETANT LES OPERATIONS DE DECOMPOSITION DE "T" (MATRICE 66 : * TRIDIAGONALE) EN PRODUIT "L.R" ("L" MATRICE TRIANGULAIRE 67 : * INFERIEURE UNITAIRE ET "R" MATRICE TRIANGULAIRE SUPERIEURE) ET DE 68 : * RECOMBINAISON DE "R" ET "L" EN "T = R.L" (NOUVELLE MATRICE 69 : * TRIDIAGONALE), ON ARRIVE A UNE MATRICE "L" UNITAIRE ET DES 70 : * MATRICES "T" ET "R" CONTENANT LES VALEURS PROPRES SUR LA 71 : * DIAGONALE. 72 : * 73 : * DANS LE CAS PARTICULIER D'UNE MATRICE "T" TRIDIAGONALE, LES 74 : * MATRICES "L" ET "R" ONT LES FORMES PARTICULIERES SUIVANTES: 75 : * 76 : * | 1 0 0 0 0 0 | | R1 1 0 0 0 0 | 77 : * | L1 1 0 0 0 0 | | 0 R2 1 0 0 0 | 78 : * "L" = | 0 L2 1 0 0 0 | "R" = | 0 0 R3 1 0 0 | 79 : * | 0 0 L3 1 0 0 | | 0 0 0 R4 1 0 | 80 : * | 0 0 0 L4 1 0 | | 0 0 0 0 R5 1 | 81 : * | 0 0 0 0 L5 1 | | 0 0 0 0 0 R6 | 82 : * 83 : * ET LES DECOMPOSITIONS ET RECOMBINAISONS PRENNENT UNE FORME TRES 84 : * SIMPLE. 85 : * 86 : * PAR LA TECHNIQUE DU DECALAGE, ON PROVOQUE LA CONVERGENCE DU 87 : * DERNIER TERME DIAGONAL DE "T" EN PREMIER. 88 : * APRES CHAQUE CONVERGENCE, ON CONSIDERE UNE NOUVELLE MATRICE "T" 89 : * EXTRAITE DE LA PRECEDENTE EN ENLEVANT LA DERNIERE LIGNE ET LA 90 : * DERNIERE COLONNE. 91 : * 92 : * AUTEUR, DATE DE CREATION: 93 : * ------------------------- 94 : * 95 : * PASCAL MANIGOT 27 FEVRIER 1985 96 : * 97 : * LANGAGE: 98 : * -------- 99 : * 100 : * FORTRAN77 101 : * 102 : ************************************************************************ 103 : * 104 : ** RQ: PROBLEME NON REGLE: TERME DIAGONAL NUL ET TEST DE CONVERGENCE 105 : ** SUR DES VALEURS RELATIVES. 106 : * 107 : IMPLICIT INTEGER(I-N) 108 : REAL*8 DIAG(*),SSDIAG(*),PRECI1,PRECI2 109 : REAL*8 SOMDEC,DEC,DD 110 : * 111 : LOGICAL CONVRG 112 : * 113 : * write(6,*) ' entreee dans valpr2 nterme',nterme 114 : * write(6,*) ' diag(nterme-1),ssdiag(nterme-1)' 115 : * write(6,*) diag(nterme-1),ssdiag(nterme-1) 116 : * write(6,*) ' diag ', ( diag(iou),iou=1,nterme) 117 : * write(6,*) ' ssdiag ',( ssdiag(iou),iou=1,nterme) 118 : DO 100 IB100=1,(NTERME-1) 119 : * 120 : NREST1 = NTERME - IB100 121 : NRESTE = NREST1 + 1 122 : SOMDEC = 0.D0 123 : * 124 : DO 110 IB110=1,NBITER 125 : * 126 : * DECOMPOSITION: "T" --> "L.R" 127 : DO 120 IB=2,NRESTE 128 : IBM1 = IB - 1 129 : if(diag(ibm1).eq.0.D0) then 130 : write(6,*) ' ib110 ib ', ib110,ib 131 : endif 132 : SSDIAG(IBM1) = SSDIAG(IBM1)/DIAG(IBM1) 133 : DIAG(IB) = DIAG(IB) - SSDIAG(IBM1) 134 : 120 CONTINUE 135 : * END DO 136 : * 137 : * RECOMBINAISON: "R.L" --> "T" 138 : DO 130 IB=1,NREST1 139 : DIAG(IB) = DIAG(IB) + SSDIAG(IB) 140 : SSDIAG(IB) = SSDIAG(IB) * DIAG(IB+1) 141 : 130 CONTINUE 142 : * END DO 143 : * 144 : IF (PRECI1 .LE. 0.D0) THEN 145 : * TEST RELATIF: 146 : DD = DIAG(NRESTE) + SOMDEC 147 : CONVRG = ABS(SSDIAG(NREST1)) .LT. ABS(DD * PRECI2) 148 : ELSE 149 : * "PRECI2" VAUT "0." 150 : * TEST ABSOLU: 151 : CONVRG = ABS(SSDIAG(NREST1)) .LT. PRECI1 152 : END IF 153 : * 154 : IF (CONVRG) THEN 155 : * --> SORTIE DE BOUCLE N.110 156 : GOTO 112 157 : END IF 158 : * 159 : DEC = DIAG(NRESTE) 160 : SOMDEC = SOMDEC + DEC 161 : * 162 : * DECALAGE: 163 : DO 140 IB140=1,NRESTE 164 : DIAG(IB140) = DIAG(IB140) - DEC 165 : 140 CONTINUE 166 : * END DO 167 : * 168 : 110 CONTINUE 169 : write(6,*)'on a pas convergé dans les ',nbiter,' iterations' 170 : write(6,*)' ib100 = ' , ib100 171 : * END DO 172 : 112 CONTINUE 173 : * 174 : DO 150 IB=1,NRESTE 175 : DIAG(IB) = DIAG(IB) + SOMDEC 176 : 150 CONTINUE 177 : * END DO 178 : * 179 : 100 CONTINUE 180 : 181 : * END DO 182 : * 183 : * RQ: LES VALEURS PROPRES SONT DANS "DIAG". 184 : * 185 : END 186 : 187 :
© Cast3M 2003 - All rights reserved.
Disclaimer