Download racc.eso

Back to the list

   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
  74 :       CALL WNVXC(X1,A1,A2,A3,G1,G2,WX1,WXP)
  75 :       X = X1
  76 :       WX = WX1
  77 :       LOGCAL = ABS(WX) .GT. EPSI 
  78 :       NITER1 = NITER/2 + 1
  79 :       ITER=0
  80 :       DO WHILE(LOGCAL)
  81 :          ITER=ITER+1
  82 :          X=X-WX/WXP
  82 :          CALL WNVXC(X,A1,A2,A3,G1,G2,WX,WXP)
  83 :          LOGCAL =  (ABS(WX) .GT. EPSI) .AND. (ITER .LT. NITER1)
  84 :       ENDDO
  85 :       LOGCAL =  (ABS(WX) .GT. EPSI)
  86 :       IF(LOGCAL)THEN
  87 : C
  88 : C**** Plus de NITER1 iterations -> on utilise la methode de la secante
  89 : C
  90 : C     N.B. La mèthode de la secante converge si F(X1)*F(X2) < 0
  91 : C
  92 : C     Definition de  X2, WX2 
  93 : C
  94 :          X2 = X
  95 :          WX2 = WX
  96 :          AUX = WX1*WX2
  97 :          LOGCA1 = AUX .GT. 0.0D0
  98 :          I1 = 0
  99 :          NITER2 = 100
 100 :          DO WHILE(LOGCA1)
 101 : C
 102 : C******* Il faut chercher X2 pour avoir WX1*WX2 < 0
 103 : C        Maximum NITER2 iterations
 104 : C         
 105 :             I1 = I1 + 1
 106 :             X2 = -2.0D0 * ( X2 + SIGN(1.0D0,X2) )
 107 : C
 108 : C********** SIGN(1.0D0,X2) necessaire si X2 = 0.0D0
 109 : C            
 109 :             CALL WNVXC(X2,A1,A2,A3,G1,G2,WX2,WXP)
 110 :             AUX = WX1*WX2
 111 :             LOGCA1 = (AUX .GT. 0.0D0) .AND. (I1 .LT. NITER2)
 112 :          ENDDO
 113 :          IF(AUX .GT. 0.0D0)THEN            
 114 :             MESERR = 'RIEMAN, subroutine racc.eso             '
 115 :             LOGAN = .TRUE.
 116 :             GOTO 9999
 117 :          ENDIF
 118 :          LOGCA1 = LOGCAL
 119 :          DO WHILE(LOGCA1)
 120 :             IF((WX*WX1) .GT. 0)THEN
 121 :                X1 = X
 122 :                WX1 = WX
 123 :             ELSE
 124 :                X2 = X
 125 :                WX2 = WX
 126 :             ENDIF
 127 :             ITER = ITER + 1
 128 :             X  = X2 - WX2*(X2 - X1)/(WX2-WX1)
 128 :             CALL WNVXC(X,A1,A2,A3,G1,G2,WX,WXP)
 129 :             LOGCA1 =  (ABS(WX) .GT. EPSI) .AND. (ITER .LT. NITER)
 130 :          ENDDO   
 131 :          LOGCA1 = (ABS(WX) .GT. EPSI)
 132 :          IF(LOGCA1)THEN
 133 :             LOGNC = .TRUE.
 134 :             MESERR = 'RIEMAN, subroutine racc.eso             '
 135 :          ENDIF
 136 :       ENDIF
 137 : C
 138 :  9999 CONTINUE
 139 : C
 140 :       RETURN
 141 :       END
 142 :  
 143 :  
 144 :  

© Cast3M 2003 - All rights reserved.
Disclaimer