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