Esope source files

   1 : C RACFGA    SOURCE    CHAT      05/01/13    02:44:15     5004           
   2 : C***********************************************************************
   3 : C*                                                                     *
   4 : C* PROJET      : Opérateur LIMI                                        *
   5 : C* NOM         : RACFGA                                                *
   6 : C* DESCRIPTION : Ce sous programme calcule la valeur du paramètre      *
   7 : C*               gamma intervenant dans une des relations de fermeture *
   8 : C*               de Cousteix. Le calcul consiste à rechercher la       *
   9 : C*               racine de la relation comprise entre deux bornes      *
  10 : C*               par la méthode de dichotomie                          *
  11 : C* LANGAGE     : Esope                                                 *
  12 : C* AUTEUR      : Guillaume VENCO - DRN/DMT/SEMT/LTMF                   *
  13 : C*                                                                     *
  14 : C***********************************************************************
  15 : C*                                                                     *
  16 : C* APPELES     : FONCTIONS FGAMMA                                *
  17 : C*                                                                     *
  18 : C***********************************************************************
  19 : C*                                                                     *
  20 : C* ENTREES     : UE  : -Champ de vitesse extérieure                    *
  21 : C*               D1  : -Epaisseur de déplacement                       *
  22 : C*               HN  : -Facteur de forme                               *
  23 : C*               A0  : -Borne inférieure                               *
  24 : C*               B0  : -Borne supérieure                               *
  25 : C*                                                                     * 
  26 : C* SORTIES     : Q   : -Racine comprise entre A0 et B0, cad gamma      *
  27 : C*                                                                     *
  28 : C***********************************************************************
  29 : C*                                                                     *
  30 : C* VERSION     : 15/05/2000                                            *
  31 : C* CREATION    : 21/04/2000                                                      *
  32 : C*                                                                     *
  33 : C***********************************************************************
  34 : 
  35 :       SUBROUTINE RACFGA(UE,D1,HN,Q,A0,B0)
  36 :       IMPLICIT INTEGER(I-N)
  37 :       IMPLICIT REAL*8 (A-H,O-Z)
  38 : C*       *********************************
  39 : C*       *** Déclaration des variables ***
  40 : C*       *********************************
  41 : 
  42 :       REAL*8 UE,D1,HN,Q,X
  43 :       REAL*8 A,A0,B,B0,f1,f2,fx,a1,a2,a3,fg
  44 :       PARAMETER (eps=1.d-15)
  45 : 
  46 : C*       *********************************
  47 : C*       ******** Sous-programme *********
  48 : C*       *********************************
  49 :       
  50 :       A=A0
  51 :       B=B0
  52 : 
  53 : C---- Schéma itératif par dichotomie
  54 :  50   f1 = fgammb(UE,D1,HN,A)
  55 :       f2 = fgammb(UE,D1,HN,B)
  56 :       
  57 : C---- Par dichotomie
  58 :          X = A+(B-A)/2
  59 :          fx = fgammb(UE,D1,HN,X)
  60 :          IF (fx.EQ.0) GOTO 10
  61 :          IF ((fx*f1).GT.0) GOTO 20
  62 :          B = X
  63 :          GOTO 30
  64 :          
  65 :  20      A = X
  66 :          GOTO 30
  67 : 
  68 :  30      IF(ABS(B-A).LE.eps) GOTO 10
  69 :          GOTO 50     
  70 : 
  71 : C---- Résultats 
  72 :  10   Q = X
  73 : c      Write(6,*) 'La racine est :',Q
  74 :       
  75 :       RETURN
  76 :       END
  77 : 
  78 : C*       *********************************
  79 : C*       ****  Fin Sous-Programme  *******
  80 : C*       *********************************
  81 :  
  82 :  
  83 :