Télécharger la plaquette Cast3M


fr en

Télécharger racc.eso

Retour à la liste

Numérotation des lignes : 

racc

  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