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