Télécharger racc.eso

Retour à la liste

Numérotation des lignes :

  1. C RACC SOURCE CHAT 05/01/13 02:44:01 5004
  2. SUBROUTINE RACC(EPSI,NITER,G1,G2,A1,A2,A3,X,LOGNC,LOGAN,MESERR)
  3. C************************************************************************
  4. C
  5. C PROJET : CASTEM 2000
  6. C
  7. C NOM : RACC
  8. C
  9. C DESCRIPTION : Voir flurie.eso
  10. C
  11. C Calcul des intersection invariants de Riemann -
  12. C Condition de Rankine - Hugoniot.
  13. C
  14. C Parametrisation de Smoller (voir riecom.eso)
  15. C
  16. C Méthode de Newton-Raphson + Secante
  17. C
  18. C LANGAGE : FORTRAN 77
  19. C
  20. C AUTEUR : A. BECCANTINI DRN/DMT/SEMT/TTMF
  21. C
  22. C************************************************************************
  23. C
  24. C APPELES
  25. C
  26. C RACC ---- WNVXC ---- VLH1
  27. C
  28. C
  29. C************************************************************************
  30. C
  31. C Entrées :
  32. C
  33. C EPSI, NITER : paramretres pour la convergence des méhodes iteratives
  34. C
  35. C G1, G2 : les "gamma" du gaz
  36. C
  37. C A1, A2, A3 : variables definies en riecom.eso
  38. C
  39. C Sorties :
  40. C
  41. C X : solution du problème
  42. C
  43. C LOGNC : si .TRUE. -> no convergence
  44. C
  45. C LOGAN : si .TRUE. -> une anomalie a été detectée
  46. C
  47. C MESERR : message d'erreur
  48. C
  49. C************************************************************************
  50. C
  51. C HISTORIQUE (Anomalies et modifications éventuelles)
  52. C
  53. C HISTORIQUE : créé le 7.1.98
  54. C
  55. C************************************************************************
  56. C
  57. C N.B. Toutes les variables sont DECLAREES
  58. C
  59. C
  60. IMPLICIT INTEGER(I-N)
  61. INTEGER NITER,NITER1,NITER2,I1,ITER
  62. REAL*8 EPSI,G1,G2,A1,A2,A3,X1,X2,WX,WXP,WX1,WX2,AUX,X
  63. LOGICAL LOGCAL,LOGCA1,LOGNC,LOGAN
  64. CHARACTER*(40) MESERR
  65. C
  66. C**** Initialisation de LOGNC, LOGAN,MESERR ne doit pas etre faite ici.
  67. C
  68. C LOGNC = .FALSE.
  69. C LOGAN = .FALSE.
  70. C MESERR(1:40) = ' '
  71. C
  72. C**** Newton-Rapson (NITER1 iterations)
  73. C
  74. X1 = 0.0D0
  75. CALL WNVXC(X1,A1,A2,A3,G1,G2,WX1,WXP)
  76. X = X1
  77. WX = WX1
  78. LOGCAL = ABS(WX) .GT. EPSI
  79. NITER1 = NITER/2 + 1
  80. ITER=0
  81. DO WHILE(LOGCAL)
  82. ITER=ITER+1
  83. X=X-WX/WXP
  84. CALL WNVXC(X,A1,A2,A3,G1,G2,WX,WXP)
  85. LOGCAL = (ABS(WX) .GT. EPSI) .AND. (ITER .LT. NITER1)
  86. ENDDO
  87. LOGCAL = (ABS(WX) .GT. EPSI)
  88. IF(LOGCAL)THEN
  89. C
  90. C**** Plus de NITER1 iterations -> on utilise la methode de la secante
  91. C
  92. C N.B. La mèthode de la secante converge si F(X1)*F(X2) < 0
  93. C
  94. C Definition de X2, WX2
  95. C
  96. X2 = X
  97. WX2 = WX
  98. AUX = WX1*WX2
  99. LOGCA1 = AUX .GT. 0.0D0
  100. I1 = 0
  101. NITER2 = 100
  102. DO WHILE(LOGCA1)
  103. C
  104. C******* Il faut chercher X2 pour avoir WX1*WX2 < 0
  105. C Maximum NITER2 iterations
  106. C
  107. I1 = I1 + 1
  108. X2 = -2.0D0 * ( X2 + SIGN(1.0D0,X2) )
  109. C
  110. C********** SIGN(1.0D0,X2) necessaire si X2 = 0.0D0
  111. C
  112. CALL WNVXC(X2,A1,A2,A3,G1,G2,WX2,WXP)
  113. AUX = WX1*WX2
  114. LOGCA1 = (AUX .GT. 0.0D0) .AND. (I1 .LT. NITER2)
  115. ENDDO
  116. IF(AUX .GT. 0.0D0)THEN
  117. MESERR = 'RIEMAN, subroutine racc.eso '
  118. LOGAN = .TRUE.
  119. GOTO 9999
  120. ENDIF
  121. LOGCA1 = LOGCAL
  122. DO WHILE(LOGCA1)
  123. IF((WX*WX1) .GT. 0)THEN
  124. X1 = X
  125. WX1 = WX
  126. ELSE
  127. X2 = X
  128. WX2 = WX
  129. ENDIF
  130. ITER = ITER + 1
  131. X = X2 - WX2*(X2 - X1)/(WX2-WX1)
  132. CALL WNVXC(X,A1,A2,A3,G1,G2,WX,WXP)
  133. LOGCA1 = (ABS(WX) .GT. EPSI) .AND. (ITER .LT. NITER)
  134. ENDDO
  135. LOGCA1 = (ABS(WX) .GT. EPSI)
  136. IF(LOGCA1)THEN
  137. LOGNC = .TRUE.
  138. MESERR = 'RIEMAN, subroutine racc.eso '
  139. ENDIF
  140. ENDIF
  141. C
  142. 9999 CONTINUE
  143. C
  144. RETURN
  145. END
  146.  
  147.  
  148.  
  149.  

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