Download newt2.eso

Back to the list

   1 : C NEWT2     SOURCE    CHAT      05/01/13    01:56:58     5004           
   2 : C***********************************************************************
   3 : C*                                                                     *
   4 : C* PROJET      : Opérateur LIMI                                        *
   5 : C* NOM         : NEWT2                                                 *
   6 : C* DESCRIPTION : Ce sous programme calcule la racine de la relation    *
   7 : C*               de fermeture H=f(H32)(cas laminaire), comprise entre  *
   8 : C*               A00 et B00, par la méthode de dichotomie              *
   9 : C* LANGAGE     : Esope                                                 *
  10 : C* AUTEUR      : Guillaume VENCO - DRN/DMT/SEMT/LTMF                   *
  11 : C*                                                                     *
  12 : C***********************************************************************
  13 : C*                                                                     *
  14 : C* APPELES     : Aucun                                                 *
  15 : C*                                                                     *
  16 : C***********************************************************************
  17 : C*                                                                     *
  18 : C* ENTREES     : ca0 : -Coefficient de la relation de fermeture        *
  19 : C*               ca1 : -Coefficient de la relation de fermeture        *
  20 : C*               ca2 : -Coefficient de la relation de fermeture        *
  21 : C*               A00 : -Borne inférieure                               *
  22 : C*               B00 : -Borne supérieure                               *   
  23 : C*                                                                     * 
  24 : C* SORTIES     : Q   : -Racine comprise entre A00 et B00               *
  25 : C*                                                                     *
  26 : C***********************************************************************
  27 : C*                                                                     *
  28 : C* VERSION     : 15/05/2000                                            *
  29 : C* CREATION    : 21/04/2000                                                      *
  30 : C*                                                                     *
  31 : C***********************************************************************
  32 : 
  33 :       SUBROUTINE NEWT2(ca0,ca1,ca2,A00,B00,Q)
  34 : 
  35 : C*       *********************************
  36 : C*       *** Déclaration des variables ***
  37 : C*       *********************************
  38 :       
  39 :       IMPLICIT INTEGER(I-N)
  40 :       IMPLICIT REAL*8(A-H,O-Z)
  41 :       parameter (eps=1d-15)
  42 :       real*8 f1,f2
  43 :       real*8 ca0,ca1,ca2,A00,B00,Q
  44 :       real*8 a0,a1,a2
  45 : 
  46 : C*       *********************************
  47 : C*       ******** Sous-programme *********
  48 : C*       *********************************
  49 : 
  50 : C---- Coefficient de la fonction f(x)=a0.X²+a1.X+a2
  51 :          a0=(ca1/ca2)
  52 :          a1=ca0 
  53 :          a2=ca1 
  54 : 
  55 :          A=A00
  56 :          B=B00
  57 : 
  58 : C---- Schéma itératif par dichotomie
  59 :  50      f1=a0*(A**2)+a1*A+a2
  60 :          f2=a0*(B**2)+a1*B+a2    
  61 :          
  62 : C---- Par dichotomie
  63 :          X = A+(B-A)/2
  64 :          fx=a0*(X**2)+a1*X+a2
  65 :          IF (fx.EQ.0) GOTO 10
  66 :          IF ((fx*f1).GT.0) GOTO 20
  67 :          B = X
  68 :          GOTO 30
  69 :          
  70 :  20      A = X
  71 :          GOTO 30
  72 : 
  73 :  30      IF(ABS(B-A).LE.eps) GOTO 10
  74 :          GOTO 50        
  75 : 
  76 : C---- Résultats 
  77 :  10   Q = X
  78 : c      Write(6,*) 'La racine est :',Q
  79 : 
  80 :       
  81 :       RETURN
  82 :       END
  83 : 
  84 : C*       *********************************
  85 : C*       ****  Fin Sous-Programme  *******
  86 : C*       *********************************
  87 :  
  88 :  

© Cast3M 2003 - All rights reserved.
Disclaimer