1 : C FUNCO1 SOURCE BECC 09/12/07 21:15:29 6579
2 : SUBROUTINE FUNCO1(NORDP1,TMAXCV,
3 : & RG,ACVTOG,ROG,TG,RTG,ETHEG,UG,GAMG,CG,
4 : & TGS,RTGS,CVGS,ROGS,PGS,ETHEGS,UGS,
5 : & DELSGS,UMXSOL,UPXSOL,
6 : & RC1,AEQ1,XSOL,
7 : & LOGEQ,DUDT,DPDT)
8 : C************************************************************************
9 : C
10 : C PROJET : CASTEM 2000
11 : C
12 : C NOM : FUNCO1 (voir FUNCOL)
13 : C
14 : C DESCRIPTION : Calcul de l'etat choc (u-cg) et des certains
15 : C parametres utilises pour le calcul de dp/du
16 : C
17 : C LANGAGE : FORTRAN 77
18 : C
19 : C AUTEUR : A. BECCANTINI DRN/DMT/SEMT/LTMF
20 : C
21 : C************************************************************************
22 : C
23 : C APPELES : NONE
24 : C
25 : C************************************************************************
26 : C
27 : C
28 : C**** ENTREES:
29 : C
30 : C NORDP1 = degree des polynoms cv+1
31 : C TMAXCV = temperature de seuil pour cv(T)
32 : C RG = R du gaz a gauche
33 : C ACVTOT_j = \sum_{i=1,nesp} Y_i*ACV_{i,j}
34 : C ROG = masse volumique a gauche
35 : C TG = temperature a gauche
36 : C RTG = RG * TG = PG / ROG
37 : C ETHEG = energie thermique a gauche
38 : C UG = vitesse absolute a gauche
39 : C GAMG = CPG / CVG
40 : C CG = vitesse du son a gauche
41 : C TGS = temperature a droite
42 : C
43 : C**** SORTIES:
44 : C
45 : C RTGS = RG*TGS
46 : C CVGS = CV a droite
47 : C ROGS = masse volumique a droite
48 : C PGS = pression a droite
49 : C ETHEGS = energie thermique a droite
50 : C DELSGS,UMXSOL,UPXSOL,RC1,AEQ1,XSOL
51 : C = parameters pour determiner le jacobian
52 : C LOGEQ = logical: si .TRUE., TG = TGS et le jacobian
53 : C est stoke en DUDT,DPDT
54 : C
55 : C************************************************************************
56 : C
57 : C HISTORIQUE (Anomalies et modifications éventuelles)
58 : C
59 : C HISTORIQUE : Créé le 07.12.09
60 : C
61 : C************************************************************************
62 : C
63 : C N.B.: Toutes les variables sont DECLAREES
64 : C
65 : IMPLICIT INTEGER(I-N)
66 : INTEGER NORDP1,I1
67 : REAL*8 TMAXCV, T2
68 : REAL*8 RG,ACVTOG(*),ROG,TG,RTG,ETHEG,UG,CG,GAMG
69 : & ,TGS,CVGS,ROGS,PGS,ETHEGS,UGS
70 : & ,RTGS,DELSGS,UMXSOL,UPXSOL,UMSUP,RC1
71 : & ,DPDU,DPDT,DUDT,VAL
72 : & ,FUNT,FUNCV,XSOL,AEQ2,AEQ1,SIGNUM
73 : LOGICAL LOGEQ
74 : C
75 : C**** Logeq = .TRUE. -> TGS = TG
76 : C On calcule aussi DPDT,DUDT
77 : C Pour l'etat on utilize le meme formules
78 : C que dans le cas LOGEQ = .FALSE.
79 : C
80 : LOGEQ = ABS(TGS - TG) .LE. (1.0D-2 * TG)
81 : C
82 : C**** Calcul de ETHEGS, CVGS
83 : C
84 : C t2 = min (tgs, Tmaxcv)
85 : T2 = 0.5D0 * ((TGS + TMAXCV) - ABS (TGS - TMAXCV))
86 : CVGS = ACVTOG(1)
87 : ETHEGS = T2 * CVGS
88 : FUNT = 1.0D0
89 : DO I1 = 2, NORDP1, 1
90 : FUNT = FUNT * T2
91 : FUNCV = ACVTOG(I1) * FUNT
92 : CVGS = CVGS + FUNCV
93 : ETHEGS = ETHEGS + (FUNCV * T2/ I1)
94 : ENDDO
95 : C t2 = max ((tgs - Tmaxcv),0)
96 : T2 = 0.5D0 * ((TGS - TMAXCV) + ABS (TGS - TMAXCV))
97 : ETHEGS = ETHEGS + (CVGS * T2)
98 : C
99 : RTGS = RG * TGS
100 : C
101 : C**** XSOL = ROG / ROGS
102 : C XSOL t.c. RTG XSOL*XSOL + AEQ1 * XSOL - RTGS = 0
103 : C
104 : AEQ2 = RTG
105 : AEQ1 = 2.0D0 * (ETHEGS - ETHEG) + RTGS - AEQ2
106 : DELSGS = SQRT((AEQ1 * AEQ1) + (4.0D0 * RTGS * AEQ2))
107 : XSOL = (DELSGS - AEQ1) / (2.0D0 * AEQ2)
108 : ROGS = ROG / XSOL
109 : C
110 : C**** UGS, PGS
111 : C
112 : RC1 = AEQ1 + RTGS - AEQ2
113 : C
114 : C RC1 = 2.0D0*(HTHEGS - HTHEG)
115 : C
116 : C**** XSOL > 1 -> TG > TGS -> RC1 < 0
117 : C
118 : UMXSOL = 1.0D0 - XSOL
119 : SIGNUM = SIGN(1.0D0,UMXSOL)
120 : UPXSOL = 1.0D0 + XSOL
121 : UMSUP = UMXSOL / UPXSOL
122 : VAL = RC1 * UMSUP
123 : C
124 : C**** VAL > 0
125 : C
126 : VAL = SQRT(ABS(VAL))
127 : UGS = UG - SIGNUM*VAL
128 : PGS = RTGS * ROGS
129 : C
130 : C**** DUDT, DPDT
131 : C
132 : IF(LOGEQ)THEN
133 : DPDU = -1.0D0 * ROG * CG
134 : DPDT = (GAMG * PGS) / ((GAMG - 1.0D0) * TG)
135 : DUDT = DPDT / DPDU
136 : ELSE
137 : C
138 : C******* Initialisazion a zero (il sont calcules ailleur)
139 : C
140 : DPDT = 0.0D0
141 : DUDT = 0.0D0
142 : ENDIF
143 : C
144 : RETURN
145 : END
146 :
147 :
148 :
© Cast3M 2003 - All rights reserved.
Disclaimer