Esope source files

   1 : C QUIN2     SOURCE    CHAT      05/01/13    02:42:26     5004           
   2 : C***********************************************************************
   3 : C*                                                                     *
   4 : C* PROJET      : Opérateur LIMI                                        *
   5 : C* NOM         : QUIN2                                                 *
   6 : C* DESCRIPTION : Ce sous programme calcule la racine de la relations   *
   7 : C*               de fermeture dans la méthode de Karmann-Pohlhausen ,  *
   8 : C*               cad le paramètre lambda compris entre deux bornes.    *
   9 : C*               Méthode de Newton                                     *
  10 : C* LANGAGE     : Esope                                                 *
  11 : C* AUTEUR      : Guillaume VENCO - DRN/DMT/SEMT/LTMF                   *
  12 : C*                                                                     *
  13 : C***********************************************************************
  14 : C*                                                                     *
  15 : C* APPELES     : Aucun                                                 *
  16 : C*                                                                     *
  17 : C***********************************************************************
  18 : C*                                                                     *
  19 : C* ENTREES     : ca0 : -Coefficient de la relation de fermeture        *
  20 : C*               ca1 : -Coefficient de la relation de fermeture        *
  21 : C*               ca2 : -Coefficient de la relation de fermeture        *
  22 : C*               ca3 : -Coefficient de la relation de fermeture        *
  23 : C*               ca4 : -Coefficient de la relation de fermeture        *
  24 : C*               ca5 : -Coefficient de la relation de fermeture        *
  25 : C*               A0  : -Borne inférieure                               *
  26 : C*               B0  : -Borne supérieure
  27 : C*                                                                     * 
  28 : C* SORTIES     : Q   : -Racine comprise entre A0 et B0                 *
  29 : C*                                                                     *
  30 : C***********************************************************************
  31 : C*                                                                     *
  32 : C* VERSION     : 21/04/2000                                            *
  33 : C* CREATION    :                                                       *
  34 : C*                                                                     *
  35 : C***********************************************************************
  36 : 
  37 :       SUBROUTINE QUIN2(ca0,ca1,ca2,ca3,ca4,ca5,A0,B0,Q)
  38 : 
  39 : C*       *********************************
  40 : C*       *** Déclaration des variables ***
  41 : C*       *********************************
  42 :      
  43 :       IMPLICIT INTEGER(I-N)
  44 :       IMPLICIT REAL*8(A-H,O-Z)
  45 :       parameter (eps=1e-8)
  46 :       real*8 f1,f1b,f2,f2b,df1,df2
  47 :       
  48 : C*       *********************************
  49 : C*       ******** Sous-programme *********
  50 : C*       *********************************
  51 : 
  52 :       
  53 :          A=A0
  54 :          B=B0
  55 : 
  56 : C---- Schéma itératif
  57 :  50      f1 = ca0+ca1*A+ca2*(A**2)+ca3*(A**3)+ca4*(A**4)+ca5*(A**5)
  58 :          f2 = ca0+ca1*B+ca2*(B**2)+ca3*(B**3)+ca4*(B**4)+ca5*(B**5)
  59 :          df1 = ca1+2*ca2*A+3*ca3*(A**2)+4*ca4*(A**3)+5*ca5*(A**4)
  60 :          df2 = ca1+2*ca2*B+3*ca3*(B**2)+4*ca4*(B**3)+5*ca5*(B**4)
  61 : 
  62 :          X= A-f1*(B-A)/(f2-f1)
  63 :          fx = ca0+ca1*X+ca2*(X**2)+ca3*(X**3)+ca4*(X**4)+ca5*(X**5)
  64 : 
  65 :          IF (fx.EQ.0.) GOTO 10
  66 :          IF ((fx*(f2-f1)).GT.0) GOTO 20
  67 : 
  68 :          A = X
  69 :          B = B-f2/df2
  70 :          GOTO 30
  71 : 
  72 :  20      B = X
  73 :          A = A-f1/df1
  74 :          GOTO 30
  75 :  
  76 :  30      IF (ABS(B-A).LT.eps) GOTO 10
  77 :          GOTO 50
  78 : 
  79 : C---- Résultat 
  80 :  10   Q = X
  81 : c      Write(6,*) 'La racine est :',Q
  82 : 
  83 :       
  84 :       RETURN
  85 :       END
  86 :  
  87 :