1 : C CL291T SOURCE CHAT 05/01/12 22:04:19 5004
2 : SUBROUTINE CL291T(NSP,MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO,
3 : & ICHPSU,LRECP,LRECV,IROC,IVITC,IPC,IYC,
4 : & IKAN,IEPSN,ICHLIM,ICHRES,ICHRLI)
5 : C************************************************************************
6 : C
7 : C PROJET : CASTEM 2000
8 : C
9 : C NOM : CLI291T
10 : C
11 : C DESCRIPTION : Subroutine appellée par CLIM22
12 : C Supersonic Outlet B.C.
13 : C
14 : C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
15 : C
16 : C AUTEUR : S. Kudriakov, DEN/DM2S/SFME/LTMF
17 : C
18 : C************************************************************************
19 : C ENTREES : NSP (type ENTIER) : full number of species
20 : C ('ESPEULE' + 1) ;
21 : C MELEMF (type MELEME) : maillage des faces des
22 : C éléments.
23 : C MELEMC (type MELEME) : maillage des centres des
24 : C éléments.
25 : C MELECB (type MELEME) : maillage des centres des éléments
26 : C de la frontière
27 : C MELEFC (type MELEME) : connectivités face-(centre
28 : C gauche, centre droit).
29 : C INORM (type MCHPOI) : normales at the faces
30 : C ICHPVO (type MCHPOI) : volumes of the cells
31 : C ICHPSU (type MCHPOI) : surfaces of the cell-interfaces
32 : C LRECP (type MLREEL) : list of CP's of the species
33 : C LRECV (type MLREEL) : list of CV's of the species
34 : C IROC (type MCHPOI) : densityes at the centres of the domain
35 : C IVITC (type MCHPOI) : velocities at the centres of the domain
36 : C IPC (type MCHPOI) : pressure at the centres of the domain
37 : C IYN (type MCHPOI) : mass fraction of the species at the
38 : C centres of the domain
39 : C IKAN (type MCHPOI) : turbulent kinetic energy, k,
40 : C at the centres of the domain
41 : C IEPSN (type MCHPOI) : rate of dissipated turb. energy
42 : C at the centres of the domain
43 : C ICHLIM (type MCHPOI) : boundary conditions at the centers
44 : C of the boundary (CHPVID here)
45 : C-----------------------------------------------------
46 : C SORTIES: ICHRES (type MCHPOI) : the contribution to the residuum
47 : C due to the boundary conditions
48 : C given at the centres of the cells
49 : C next to the boundary
50 : C ICHRLI (type MCHPOI) : the values at the boundary faces
51 : C found by the procedure.
52 : C************************************************************************
53 : C
54 : C APPELES (Calcul) :
55 : C
56 : C************************************************************************
57 : C
58 : C HISTORIQUE (Anomalies et modifications éventuelles)
59 : C
60 : C HISTORIQUE :
61 : C
62 : C************************************************************************
63 : C
64 : IMPLICIT INTEGER(I-N)
65 : -INC CCOPTIO
66 : -INC SMLMOTS
67 : -INC SMELEME
68 : POINTEUR MELEFC.MELEME,MELEMF.MELEME,MELEMC.MELEME,MELECB.MELEME
69 : -INC SMLENTI
70 : POINTEUR MLEMC.MLENTI, MLEMCB.MLENTI,MLEMF.MLENTI
71 : -INC SMCHPOI
72 : POINTEUR MPNORM.MPOVAL, MPVOL.MPOVAL, MPSURF.MPOVAL, MPRC.MPOVAL,
73 : & MPVC.MPOVAL, MPPC.MPOVAL, MPYC.MPOVAL, MPLIM.MPOVAL,
74 : & MPRES.MPOVAL, MPRLI.MPOVAL,MPKAC.MPOVAL,MPEPSC.MPOVAL
75 : C
76 : C**** Variables de COOPTIO
77 : C
78 : C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
79 : C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
80 : C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
81 : C & ,IECHO, IIMPI, IOSPI
82 : C & ,IDIM, IFICLE, IPREFI
83 : C & ,MCOORD
84 : C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
85 : C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
86 : C & ,NORINC,NORVAL,NORIND,NORVAD
87 : C & ,NUCROU, IPSAUV
88 : C
89 : INTEGER INORM,ICHPVO,ICHPSU, IROC,IVITC,IPC
90 : & ,IYC,ICHLIM,ICHRES,ICHRLI,ICEL,NFAC,IFAC,IKAN, IEPSN
91 : & ,NGF,NGC,NLF,NLC,NLCB,LRECP,LRECV,NSP,NESP,I
92 : REAL*8 VOLU,SURF,GAMC,CNX,CNY,CNZ,CTX,CTY,CTZ
93 : & ,CT2X,CT2Y,CT2Z,RC,PC,UXC,UYC,UZC,PF,TOP,BOT
94 : & ,UNC,UTC,UT2C,CELLT,EPSC,KAC
95 : CHARACTER*(8) TYPE
96 : C-------------------------------------------------------
97 : -INC SMLREEL
98 : POINTEUR MLRECP.MLREEL, MLRECV.MLREEL
99 : C-------------------------------------------------------
100 : C********** Les CP's and CV's ***********************
101 : C-------------------------------------------------------
102 : SEGMENT GCONST
103 : REAL*8 GC(NSP)
104 : ENDSEGMENT
105 : POINTEUR CP.GCONST, CV.GCONST
106 : C-------------------------------------------------------------
107 : C******* Les fractionines massiques **************************
108 : C-------------------------------------------------------------
109 : SEGMENT FRAMAS
110 : REAL*8 YET(NSP)
111 : ENDSEGMENT
112 : POINTEUR YC.FRAMAS
113 : C-------------------------------------------------------------
114 : C********** Segments for the flux-vector *******************
115 : C-------------------------------------------------------------
116 : SEGMENT FUNEL
117 : REAL*8 FU(IDIM+1+NSP)
118 : ENDSEGMENT
119 : POINTEUR flux2D.funel, flux3D.funel
120 : SEGINI FLUX2D
121 : SEGINI FLUX3D
122 : C------------------------------------------------------------
123 : C**** KRIPAD pour la correspondance global/local
124 : C------------------------------------------------------------
124 : CALL KRIPAD(MELEMC,MLEMC)
124 : CALL KRIPAD(MELECB,MLEMCB)
124 : CALL KRIPAD(MELEMF,MLEMF)
125 : C--------------------------------------------
126 : C**** CHPOINTs de la table DOMAINE
127 : C--------------------------------------------
127 : CALL LICHT(INORM,MPNORM,TYPE,ICEL)
127 : CALL LICHT(ICHPVO,MPVOL,TYPE,ICEL)
127 : CALL LICHT(ICHPSU,MPSURF,TYPE,ICEL)
128 : C----------------------------------------
129 : C**** CHPOINTs des variables
130 : C----------------------------------------
130 : CALL LICHT(IROC,MPRC,TYPE,ICEL)
130 : CALL LICHT(IVITC,MPVC,TYPE,ICEL)
130 : CALL LICHT(IPC,MPPC,TYPE,ICEL)
130 : CALL LICHT(IYC,MPYC,TYPE,ICEL)
130 : CALL LICHT(IKAN,MPKAC,TYPE,ICEL)
130 : CALL LICHT(IEPSN,MPEPSC,TYPE,ICEL)
130 : CALL LICHT(ICHLIM,MPLIM,TYPE,ICEL)
130 : CALL LICHT(ICHRES,MPRES,TYPE,ICEL)
130 : CALL LICHT(ICHRLI,MPRLI,TYPE,ICEL)
131 : C---------------------------------------------------------
132 : C**** Boucle sur le face pour le calcul des invariants de
133 : C Riemann et du flux
134 : C---------------------------------------------------------
135 : SEGACT MELEFC
136 : NFAC=MELEFC.NUM(/2)
137 : UZC=0.0D0
138 : CNZ=0.0D0
139 : CTZ=0.0D0
140 : CT2X=0.0D0
141 : CT2Y=0.0D0
142 : CT2Z=0.0D0
143 : DO IFAC=1,NFAC,1
144 : NGF=MELEFC.NUM(1,IFAC)
145 : NGC=MELEFC.NUM(2,IFAC)
146 : NLF=MLEMF.LECT(NGF)
147 : NLC=MLEMC.LECT(NGC)
148 : NLCB=MLEMCB.LECT(NGF)
149 : VOLU=MPVOL.VPOCHA(NLC,1)
150 : SURF=MPSURF.VPOCHA(NLF,1)
151 : C In CASTEM les normales sont sortantes
152 : CNX=MPNORM.VPOCHA(NLF,1)
153 : CNY=MPNORM.VPOCHA(NLF,2)
154 : IF(IDIM.EQ.2)THEN
155 : CTX=-1.0D0*CNY
156 : CTY=CNX
157 : ELSE
158 : CNZ=MPNORM.VPOCHA(NLF,3)
159 : CTX=MPNORM.VPOCHA(NLF,4)
160 : CTY=MPNORM.VPOCHA(NLF,5)
161 : CTZ=MPNORM.VPOCHA(NLF,6)
162 : CT2X=MPNORM.VPOCHA(NLF,7)
163 : CT2Y=MPNORM.VPOCHA(NLF,8)
164 : CT2Z=MPNORM.VPOCHA(NLF,9)
165 : ENDIF
166 : C--------------------------------------------
167 : SEGINI CP, CV
168 : MLRECP = LRECP
169 : MLRECV = LRECV
170 : SEGACT MLRECP, MLRECV
171 : DO 10 I=1,(NSP-1)
172 : CP.GC(I)=MLRECP.PROG(I)
173 : CV.GC(I)=MLRECV.PROG(I)
174 : 10 CONTINUE
175 : CP.GC(NSP)=MLRECP.PROG(NSP)
176 : CV.GC(NSP)=MLRECV.PROG(NSP)
177 : C----------------------------------------
178 : C Variables au centre
179 : C----------------------------------------
180 : RC=MPRC.VPOCHA(NLC,1)
181 : UXC=MPVC.VPOCHA(NLC,1)
182 : UYC=MPVC.VPOCHA(NLC,2)
183 : IF(IDIM.EQ.3)UZC=MPVC.VPOCHA(NLC,3)
184 : PC=MPPC.VPOCHA(NLC,1)
185 : SEGINI YC
186 : SEGACT MPYC
187 : DO 101 I=1,(NSP-1)
188 : YC.YET(I)=MPYC.VPOCHA(NLC,I)
189 : 101 CONTINUE
190 : KAC=MPKAC.VPOCHA(NLC,1)
191 : EPSC=MPEPSC.VPOCHA(NLC,1)
192 : c-------------------------------------------------------------
193 : c Computing GAMMA at the cell-center
194 : c-------------------------------------------------------------
195 : top=0.0D0
196 : bot=0.0D0
197 : do 102 i=1,(nsp-1)
198 : top=top+yc.yet(i)*(cp.gc(i)-cp.gc(nsp))
199 : bot=bot+yc.yet(i)*(cv.gc(i)-cv.gc(nsp))
200 : 102 continue
201 : top=cp.gc(nsp)+top
202 : bot=cv.gc(nsp)+bot
203 : GAMC=top/bot
204 : C-----------------------------------------
205 : C Variables à la face
206 : C-----------------------------------------
207 : PF = PC
208 : C---------------------------------------
209 : C******* On calcule UN, UT, UT2
210 : C---------------------------------------
211 : UNC=(UXC*CNX)+(UYC*CNY)+(UZC*CNZ)
212 : UTC=(UXC*CTX)+(UYC*CTY)+(UZC*CTZ)
213 : UT2C=(UXC*CT2X)+(UYC*CT2Y)+(UZC*CT2Z)
214 : C-----------------------------------------------
215 : C******* Densite, vitesse, pression sur le bord
216 : C-----------------------------------------------
217 : MPRLI.VPOCHA(NLCB,1)=RC
218 : MPRLI.VPOCHA(NLCB,2)=UXC
219 : MPRLI.VPOCHA(NLCB,3)=UYC
220 : IF(IDIM.EQ.3) MPRLI.VPOCHA(NLCB,4)=UZC
221 : MPRLI.VPOCHA(NLCB,IDIM+2)=PF
222 : do 104 i=1,(nsp-1)
223 : MPRLI.VPOCHA(NLCB,IDIM+2+I)=YC.YET(I)
224 : 104 continue
225 : MPRLI.VPOCHA(NLCB,IDIM+NSP+2)=KAC
226 : MPRLI.VPOCHA(NLCB,IDIM+NSP+3)=EPSC
227 : C---------------------------------------------------
228 : C******* Probleme de Riemann entre l'etat gauche
229 : C RC,UNC,UTC,UT2C,PC et l'etat droite
230 : C RC,UNC,UTC,UT2C,PF
231 : C On utilise AUSM+
232 : C Flux dans le repaire normale
233 : C---------------------------------------------------
234 : NESP=NSP-1
235 : IF(IDIM.EQ.2)THEN
235 : CALL FAUSMP(NESP,
236 : & GAMC,RC,PC,UNC,UTC,
237 : & GAMC,RC,PF,UNC,UTC,
238 : & YC.YET,YC.YET,
239 : & FLUX2D.FU,
240 : & CELLT)
241 : C-------------------------------------------------------
242 : C******* Residuum (son SPG a le meme ordre que MELEFC)
243 : C-------------------------------------------------------
244 : MPRES.VPOCHA(IFAC,1)=-1*FLUX2D.FU(1)*SURF/VOLU
245 : MPRES.VPOCHA(IFAC,2)=-1*((FLUX2D.FU(2)*CNX)+
246 : & (FLUX2D.FU(3)*CTX))*SURF/VOLU
247 : MPRES.VPOCHA(IFAC,3)=-1*((FLUX2D.FU(2)*CNY)+
248 : & (FLUX2D.FU(3)*CTY))*SURF/VOLU
249 : MPRES.VPOCHA(IFAC,4)=-1*FLUX2D.FU(4)*SURF/VOLU
250 : do 105 i=1,(nsp-1)
251 : MPRES.VPOCHA(IFAC,4+I)=-1*FLUX2D.FU(4+I)*SURF/VOLU
252 : 105 continue
253 : MPRES.VPOCHA(IFAC,4+NSP)=-1*KAC*FLUX2D.FU(1)*SURF/VOLU
254 : MPRES.VPOCHA(IFAC,5+NSP)=-1*EPSC*FLUX2D.FU(1)*SURF/VOLU
255 : ELSE
255 : CALL FAUSM3(NESP,
256 : & GAMC,RC,PC,UNC,UTC,UT2C,
257 : & GAMC,RC,PF,UNC,UTC,UT2C,
258 : & YC.YET,YC.YET,
259 : & FLUX3D.FU,
260 : & CELLT)
261 : C------------------------------------------------------
262 : C******* Residuum (son SPG a le meme ordre que MELEFC)
263 : C------------------------------------------------------
264 : MPRES.VPOCHA(IFAC,1)=-1*FLUX3D.FU(1)*SURF/VOLU
265 : MPRES.VPOCHA(IFAC,2)=-1*((FLUX3D.FU(2)*CNX)+
266 : & (FLUX3D.FU(3)*CTX)+(FLUX3D.FU(4)*CT2X))*SURF/VOLU
267 : MPRES.VPOCHA(IFAC,3)=-1*((FLUX3D.FU(2)*CNY)+
268 : & (FLUX3D.FU(3)*CTY)+(FLUX3D.FU(4)*CT2Z))*SURF/VOLU
269 : MPRES.VPOCHA(IFAC,4)=-1*((FLUX3D.FU(2)*CNZ)+
270 : & (FLUX3D.FU(3)*CTZ)+(FLUX3D.FU(4)*CT2Z))*SURF/VOLU
271 : MPRES.VPOCHA(IFAC,5)=-1*FLUX3D.FU(5)*SURF/VOLU
272 : do 106 i=1,(nsp-1)
273 : MPRES.VPOCHA(IFAC,5+I)=-1*FLUX3D.FU(5+I)*SURF/VOLU
274 : 106 continue
275 : MPRES.VPOCHA(IFAC,5+NSP)=-1*KAC*FLUX3D.FU(1)*SURF/VOLU
276 : MPRES.VPOCHA(IFAC,6+NSP)=-1*EPSC*FLUX3D.FU(1)*SURF/VOLU
277 : ENDIF
278 : ENDDO
279 : C
280 : SEGDES MELEFC
281 : C
282 : SEGDES MLEMC
283 : SEGDES MLEMCB
284 : SEGDES MLEMF
285 : C
286 : SEGDES MPNORM
287 : SEGDES MPVOL
288 : SEGDES MPSURF
289 : SEGDES MPRC
290 : SEGDES MPPC
291 : SEGDES MPVC
292 : SEGDES MPYC
293 : SEGDES MPKAC
294 : SEGDES MPEPSC
295 : c SEGDES MPLIM
296 : SEGDES MPRES
297 : SEGDES MPRLI
298 : SEGDES YC
299 : SEGDES FLUX2D
300 : SEGDES FLUX3D
301 : C
302 : 9999 CONTINUE
303 : RETURN
304 : END
305 :
306 :
307 :
308 :
309 :
310 :
311 :
312 :
313 :
314 :
315 :
© Cast3M 2003 - All rights reserved.
Disclaimer