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