1 : C LEBAL2 SOURCE PV 07/11/23 21:17:41 5978 2 : C*********************************************************************** 3 : C* * 4 : C* PROJET : Opérateur LIMI * 5 : C* NOM : lEBAl2 * 6 : C* DESCRIPTION : Ce sous programme calcule la valeur du facteur de * 7 : C* forme H à partir de la valeur de H*, en utilisant * 8 : C* la formule de Le Balleur. Le calcul consiste à * 9 : C* rechercher la racine de la relation comprise entre * 10 : C* entre deux bornes 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 : Aucun * 17 : C* * 18 : C*********************************************************************** 19 : C* * 20 : C* ENTREES : HH : -Facteur H* * 21 : C* beta: -Coefficient intervenant dans la formule de * 22 : C* Le Balleur * 23 : C* A0 : -Borne inférieure * 24 : C* B0 : -Borne supérieure * 25 : C* * 26 : C* SORTIES : Q : -Racine comprise entre A0 et B0, Facteur H * 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 LEBAL2(HH,BETA,Q,A0,B0) 36 : IMPLICIT INTEGER(I-N) 37 : IMPLICIT REAL*8 (a-h,o-z) 38 : 39 : C* ********************************* 40 : C* *** Déclaration des variables *** 41 : C* ********************************* 42 : 43 : REAL*8 HH,beta,Q,X 44 : REAL*8 A,A0,B,B0,f1,f2,fx 45 : PARAMETER (eps=1.d-15) 46 : 47 : C* ********************************* 48 : C* ******** Sous-programme ********* 49 : C* ********************************* 50 : 51 : A=A0 52 : B=B0 53 : 54 : C---- Schéma itératif par dichotomie 55 : 50 f1 = beta*(A**2)+(1-HH)*A+HH 56 : f2 = beta*(B**2)+(1-HH)*B+HH 57 : 58 : X = A+(B-A)/2 59 : fx = beta*(X**2)+(1-HH)*X+HH 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ésultat 72 : 10 Q = X 73 : c Write(6,*) 'La racine est :',Q 74 : 75 : RETURN 76 : 77 : END 78 : 79 : C* ********************************* 80 : C* **** Fin Sous-Programme ******* 81 : C* ********************************* 82 : 83 : 84 : 85 : 86 : 87 : 88 : 89 : 90 :
© Cast3M 2003 - All rights reserved.
Disclaimer