1 : C EQUA32 SOURCE CHAT 05/01/12 23:44:25 5004 2 : SUBROUTINE EQUA32 (AA,B, X,RESOLU) 3 : ************************************************************************ 4 : * 5 : * E Q U A 3 2 6 : * ----------- 7 : * 8 : * FONCTION: 9 : * --------- 10 : * 11 : * RESOLUTION D'UN SYSTEME DE 3 EQUATIONS A 2 INCONNUES, DE RANG 2. 12 : * 13 : * AA * X = B 14 : * 15 : * MODULES UTILISES: 16 : * ----------------- 17 : * 18 : IMPLICIT INTEGER(I-N) 19 : -INC CCOPTIO 20 : -INC CCREEL 21 : * 22 : * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN) 23 : * ----------- 24 : * 25 : * AA (E) MATRICE 3X2 DU SYSTEME. 26 : * B (E) SECOND MEMBRE DU SYSTEME. 27 : * X (S) 2 INCONNUES DU SYSTEME. 28 : * RESOLU (S) = .TRUE. SI LA RESOLUTION A PU SE FAIRE. 29 : * 30 : REAL*8 AA(3,2),B(3),X(2) 31 : LOGICAL RESOLU 32 : * 33 : * CONSTANTES: 34 : * ----------- 35 : * 36 : * IND = BIAIS POUR REPRESENTER UN INDICAGE CIRCULAIRE DE 1 A 3. 37 : * PRECIS = CRITERE DE PRECISION. 38 : * 39 : INTEGER IND(5) 40 : REAL*8 PRECIS 41 : PARAMETER (PRECIS = 1.D-5) 42 : * 43 : * VARIABLES: 44 : * ---------- 45 : * 46 : * DET = DETERMINANT 2X2 DE LA MATRICE "AA". 47 : * DETMAX = PLUS GRAND DETERMINANT EN VALEUR ABSOLUE. 48 : * 49 : REAL*8 DET,DETMAX,VERIF,B3,A1,A2 50 : * 51 : * AUTEUR, DATE DE CREATION: 52 : * ------------------------- 53 : * 54 : * PASCAL MANIGOT 18 NOVEMBRE 1987 55 : * 56 : * LANGAGE: 57 : * -------- 58 : * 59 : * FORTRAN77 60 : * 61 : ************************************************************************ 62 : * 63 : DATA IND/1,2,3,1,2/ 64 : * 65 : I=1 66 : DETMAX = 0.D0 67 : DO 100 IB=1,3 68 : DET = AA(IND(IB),1) * AA(IND(IB+1),2) 69 : & - AA(IND(IB+1),1) * AA(IND(IB),2) 70 : IF (ABS(DET) .GT. ABS(DETMAX) ) THEN 71 : DETMAX = DET 72 : I = IB 73 : END IF 74 : 100 CONTINUE 75 : * END DO 76 : * 77 : * ON RESOUT EN PRENANT LES 2 EQUATIONS CORRESPONDANT AU PLUS GRAND 78 : * DETERMINANT. 79 : * 80 : X(1) = ( B(IND(I)) * AA(IND(I+1),2) 81 : & - B(IND(I+1)) * AA(IND(I),2) ) / DETMAX 82 : X(2) = ( AA(IND(I),1) * B(IND(I+1)) 83 : & - AA(IND(I+1),1) * B(IND(I)) ) / DETMAX 84 : * 85 : * ON VERIFIE LA 3EME EQUATION 86 : * 87 : A1 = AA(IND(I+2),1) * X(1) 88 : A2 = AA(IND(I+2),2) * X(2) 89 : VERIF = A1 + A2 90 : B3 = B(IND(I+2)) 91 : IF (IIMPI .EQ. 732) THEN 92 : WRITE (IOIMP,*) 'VERIF,B3,A1,A2' 93 : WRITE (IOIMP,*) VERIF,B3,A1,A2 94 : END IF 95 : * 96 : IF (ABS(B3) .LT. XPETIT) THEN 97 : A1 = ABS(A1) 98 : A2 = ABS(A2) 99 : B3 = MAX(A1,A2) * PRECIS 100 : RESOLU = ABS(VERIF) .LE. B3 101 : ELSE 102 : VERIF = (VERIF - B3) / B3 103 : RESOLU = ABS(VERIF) .LE. PRECIS 104 : END IF 105 : IF (IIMPI .EQ. 732) THEN 106 : WRITE (IOIMP,*) 'VERIF' 107 : WRITE (IOIMP,*) VERIF 108 : END IF 109 : * 110 : END 111 : 112 : 113 :
© Cast3M 2003 - All rights reserved.
Disclaimer