Télécharger dertra.eso

Retour à la liste

Numérotation des lignes :

  1. C DERTRA SOURCE PV 15/04/13 21:15:06 8474
  2. SUBROUTINE DERTRA(NPTS,TRAC,X,Y,YPRIM,XINF,XSUP)
  3. C
  4. C--------------------------------------------------------------------
  5. C Objet: calcul de la valeur d'une fonction F et de sa derivee
  6. C en un point X donne.Cette fonction est discretisee
  7. C en NPTS/2 points et tabulee dans un tableau de forme
  8. C suivante Trac(X1,F(X1),X2,F(X2),.........) avec X1<X2<...
  9. C--------------------------------------------------------------------
  10. C
  11. C--------------------------------------------------------------------
  12. C Entree: NPTS dimension du tableau TRAC
  13. C TRAC tableau de la fonction tabulee
  14. C X point ou sera calcule la fonction et sa derivee
  15. C--------------------------------------------------------------------
  16. C
  17. C--------------------------------------------------------------------
  18. C Sortie: Y valeur de la fonction en X
  19. C YPRIM valeur de la derivee en X
  20. C XINF,XSUP bornes entre lesquelles est compris X
  21. C--------------------------------------------------------------------
  22. IMPLICIT INTEGER(I-N)
  23. IMPLICIT REAL*8 (A-H,O-Z)
  24. DIMENSION TRAC(*)
  25. -INC CCREEL
  26. C
  27. EPS1=1.D-14
  28. LIMIT=NPTS-1
  29. C----------------------------------------------------------------
  30. C la fonction est constante ou X est inferieur a la plus petite
  31. C des abscisses ou X est superieur a la plus grande des abscisses
  32. C----------------------------------------------------------------
  33. IF (NPTS.EQ.1) THEN
  34. Y=TRAC(1)
  35. YPRIM=0.D0
  36. XINF1=X
  37. XSUP1=X
  38. GOTO 250
  39. ENDIF
  40. IF (X.LT.TRAC(1)) THEN
  41. Y=TRAC(2)
  42. YPRIM=0.D0
  43. XINF1=X
  44. XSUP1=X
  45. GOTO 250
  46. ENDIF
  47. IF (X.GT.TRAC(LIMIT)) THEN
  48. Y=TRAC(NPTS)
  49. YPRIM=0.D0
  50. XINF1=X
  51. XSUP1=X
  52. GOTO 250
  53. ENDIF
  54. C
  55. C-------------------------------------------------------------------
  56. C Recherche de l'intervalle [A,B] comprenant X
  57. C-------------------------------------------------------------------
  58. EPS2=ABS(X)*EPS1
  59. XPLUS=X+EPS2
  60. XMOINS=X-EPS2
  61. * recherche par dichotomie
  62. NPT=NPTS/2
  63. IHAU=NPT
  64. IDEP=1
  65. IBAS=2*IDEP-IHAU
  66. 15 CONTINUE
  67. IDEP=(IBAS+IHAU)/2
  68. IF (IDEP*2+1.GT.LIMIT) THEN
  69. I=LIMIT
  70. GOTO 10
  71. ENDIF
  72. IF (IDEP.LE.1) THEN
  73. I=1
  74. GOTO 10
  75. ENDIF
  76. IF (XMOINS.GT.TRAC(IDEP*2+1)) THEN
  77. * on est trop petit
  78. IF (IBAS.EQ.IDEP) GOTO 17
  79. IBAS=IDEP
  80. GOTO 15
  81. ELSEIF(XPLUS.LT.TRAC(IDEP*2-1)) THEN
  82. * on est trop grand
  83. IF (IHAU.EQ.IDEP) GOTO 17
  84. IHAU=IDEP
  85. GOTO 15
  86. ELSE
  87. * on est bon
  88. I=IDEP*2-1
  89. GOTO 10
  90. ENDIF
  91. 17 write(6,*) ' erreur dans la recherche dichotomique '
  92. I=1
  93. 10 CONTINUE
  94. IF (XMOINS.GT.TRAC(I+2)) THEN
  95. I=I+2
  96. IF (I.EQ.LIMIT) THEN
  97. XINF1=TRAC(LIMIT-2)
  98. FXINF=TRAC(LIMIT-1)
  99. XSUP1=TRAC(LIMIT)
  100. FXSUP=TRAC(LIMIT+1)
  101. GOTO 100
  102. ENDIF
  103. GOTO 10
  104. ENDIF
  105. IF (XMOINS.GT.TRAC(I).AND.XPLUS.LT.TRAC(I+2)) THEN
  106. XINF1=TRAC(I)
  107. FXINF=TRAC(I+1)
  108. XSUP1=TRAC(I+2)
  109. FXSUP=TRAC(I+3)
  110. GOTO 100
  111. ENDIF
  112. IF (XMOINS.LE.TRAC(I)) THEN
  113. IF ( I.EQ.1 ) THEN
  114. XINF1=TRAC(1)
  115. FXINF=TRAC(2)
  116. XSUP1=TRAC(3)
  117. FXSUP=TRAC(4)
  118. GOTO 100
  119. ELSE
  120. XINF1=TRAC(I-2)
  121. FXINF=TRAC(I-1)
  122. XSUP1=TRAC(I+2)
  123. FXSUP=TRAC(I+3)
  124. Y=TRAC(I+1)
  125. YPRIM=(FXSUP-FXINF)/max(xpetit,(XSUP1-XINF1))
  126. GOTO 250
  127. ENDIF
  128. ENDIF
  129. IF (XPLUS.GE.TRAC(I+2)) THEN
  130. IF ( I+2.EQ.LIMIT ) THEN
  131. XINF1=TRAC(LIMIT-2)
  132. FXINF=TRAC(LIMIT-1)
  133. XSUP1=TRAC(LIMIT)
  134. FXSUP=TRAC(LIMIT+1)
  135. GOTO 100
  136. ELSE
  137. XINF1=TRAC(I)
  138. FXINF=TRAC(I+1)
  139. XSUP1=TRAC(I+4)
  140. FXSUP=TRAC(I+5)
  141. Y=TRAC(I+3)
  142. YPRIM=(FXSUP-FXINF)/(XSUP1-XINF1)
  143. GOTO 250
  144. ENDIF
  145. ENDIF
  146. write (6,*) ' on ne devrait pas passer la (dans dertra) '
  147. write (6,*) ' X LIMIT I ',x,limit,i
  148. STOP 12
  149. C
  150. C------------------------------------------------------------------
  151. C Calcul de la derivee de F et de la valeur de F en X
  152. C------------------------------------------------------------------
  153. 100 YPRIM=(FXSUP-FXINF)/max(xpetit,(XSUP1-XINF1))
  154. Y=FXINF+YPRIM*(X-XINF1)
  155. 250 CONTINUE
  156. XSUP=XSUP1
  157. XINF=XINF1
  158. C
  159. RETURN
  160. END
  161.  
  162.  
  163.  
  164.  
  165.  
  166.  
  167.  
  168.  
  169.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales