Télécharger la plaquette Cast3M


fr en

Télécharger equa32.eso

Retour à la liste

Numérotation des lignes : 

equa32

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

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