1 : C CL251T SOURCE HP1 05/09/28 21:15:01 5185
2 : SUBROUTINE CL251T(NSP,MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO,
3 : & ICHPSU,LRECP,LRECV,IROC,IVITC,IPC,IYC,
4 : & IKAN,IEPSN,IK0N,ICHLIM,ICHRES,ICHRLI)
5 : C************************************************************************
6 : C
7 : C PROJET : CASTEM 2000
8 : C
9 : C NOM : CLI251T
10 : C
11 : C DESCRIPTION : Subroutine appellée par CLIM22
12 : C Outlet B.C. (known pressure)
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
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 : -INC CCOPTIO
65 : -INC SMLMOTS
66 : -INC SMELEME
67 : POINTEUR MELEFC.MELEME,MELEMF.MELEME,MELEMC.MELEME,MELECB.MELEME
68 : -INC SMLENTI
69 : POINTEUR MLEMC.MLENTI, MLEMCB.MLENTI,MLEMF.MLENTI
70 : -INC SMCHPOI
71 : POINTEUR MPNORM.MPOVAL, MPVOL.MPOVAL, MPSURF.MPOVAL, MPRC.MPOVAL,
72 : & MPVC.MPOVAL, MPPC.MPOVAL, MPYC.MPOVAL, MPLIM.MPOVAL,
73 : & MPRES.MPOVAL, MPRLI.MPOVAL,MPKAC.MPOVAL,MPEPSC.MPOVAL,
74 : & MPK0C.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 : & ,IK0N,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,K0C
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)
131 : IF (IK0N .GT. 0) THEN
131 : CALL LICHT(IK0N,MPK0C,TYPE,ICEL)
132 : ENDIF
132 : CALL LICHT(ICHLIM,MPLIM,TYPE,ICEL)
132 : CALL LICHT(ICHRES,MPRES,TYPE,ICEL)
132 : CALL LICHT(ICHRLI,MPRLI,TYPE,ICEL)
133 : C---------------------------------------------------------
134 : C**** Boucle sur le face pour le calcul des invariants de
135 : C Riemann et du flux
136 : C---------------------------------------------------------
137 : SEGACT MELEFC
138 : NFAC=MELEFC.NUM(/2)
139 : UZC=0.0D0
140 : CNZ=0.0D0
141 : CTZ=0.0D0
142 : CT2X=0.0D0
143 : CT2Y=0.0D0
144 : CT2Z=0.0D0
145 : DO IFAC=1,NFAC,1
146 : NGF=MELEFC.NUM(1,IFAC)
147 : NGC=MELEFC.NUM(2,IFAC)
148 : NLF=MLEMF.LECT(NGF)
149 : NLC=MLEMC.LECT(NGC)
150 : NLCB=MLEMCB.LECT(NGF)
151 : VOLU=MPVOL.VPOCHA(NLC,1)
152 : SURF=MPSURF.VPOCHA(NLF,1)
153 : C In CASTEM les normales sont sortantes
154 : CNX=MPNORM.VPOCHA(NLF,1)
155 : CNY=MPNORM.VPOCHA(NLF,2)
156 : IF(IDIM.EQ.2)THEN
157 : CTX=-1.0D0*CNY
158 : CTY=CNX
159 : ELSE
160 : CNZ=MPNORM.VPOCHA(NLF,3)
161 : CTX=MPNORM.VPOCHA(NLF,4)
162 : CTY=MPNORM.VPOCHA(NLF,5)
163 : CTZ=MPNORM.VPOCHA(NLF,6)
164 : CT2X=MPNORM.VPOCHA(NLF,7)
165 : CT2Y=MPNORM.VPOCHA(NLF,8)
166 : CT2Z=MPNORM.VPOCHA(NLF,9)
167 : ENDIF
168 : C--------------------------------------------
169 : SEGINI CP, CV
170 : MLRECP = LRECP
171 : MLRECV = LRECV
172 : SEGACT MLRECP, MLRECV
173 : DO 10 I=1,(NSP-1)
174 : CP.GC(I)=MLRECP.PROG(I)
175 : CV.GC(I)=MLRECV.PROG(I)
176 : 10 CONTINUE
177 : CP.GC(NSP)=MLRECP.PROG(NSP)
178 : CV.GC(NSP)=MLRECV.PROG(NSP)
179 : C----------------------------------------
180 : C Variables au centre
181 : C----------------------------------------
182 : RC=MPRC.VPOCHA(NLC,1)
183 : UXC=MPVC.VPOCHA(NLC,1)
184 : UYC=MPVC.VPOCHA(NLC,2)
185 : IF(IDIM.EQ.3)UZC=MPVC.VPOCHA(NLC,3)
186 : PC=MPPC.VPOCHA(NLC,1)
187 : SEGINI YC
188 : SEGACT MPYC
189 : DO 101 I=1,(NSP-1)
190 : YC.YET(I)=MPYC.VPOCHA(NLC,I)
191 : 101 CONTINUE
192 : KAC=MPKAC.VPOCHA(NLC,1)
193 : EPSC=MPEPSC.VPOCHA(NLC,1)
194 : IF (IK0N .GT. 0) THEN
195 : K0C=MPK0C.VPOCHA(NLC,1)
196 : ENDIF
197 : c-------------------------------------------------------------
198 : c Computing GAMMA at the cell-center
199 : c-------------------------------------------------------------
200 : top=0.0D0
201 : bot=0.0D0
202 : do 102 i=1,(nsp-1)
203 : top=top+yc.yet(i)*(cp.gc(i)-cp.gc(nsp))
204 : bot=bot+yc.yet(i)*(cv.gc(i)-cv.gc(nsp))
205 : 102 continue
206 : top=cp.gc(nsp)+top
207 : bot=cv.gc(nsp)+bot
208 : GAMC=top/bot
209 : C-----------------------------------------
210 : C Variables à la face
211 : C-----------------------------------------
212 : PF=MPLIM.VPOCHA(NLCB,1)
213 : C---------------------------------------
214 : C******* On calcule UN, UT, UT2
215 : C---------------------------------------
216 : UNC=(UXC*CNX)+(UYC*CNY)+(UZC*CNZ)
217 : UTC=(UXC*CTX)+(UYC*CTY)+(UZC*CTZ)
218 : UT2C=(UXC*CT2X)+(UYC*CT2Y)+(UZC*CT2Z)
219 : C-----------------------------------------------
220 : C******* Densite, vitesse, pression sur le bord
221 : C-----------------------------------------------
222 : MPRLI.VPOCHA(NLCB,1)=RC
223 : MPRLI.VPOCHA(NLCB,2)=UXC
224 : MPRLI.VPOCHA(NLCB,3)=UYC
225 : IF(IDIM.EQ.3) MPRLI.VPOCHA(NLCB,4)=UZC
226 : MPRLI.VPOCHA(NLCB,IDIM+2)=PF
227 : do 104 i=1,(nsp-1)
228 : MPRLI.VPOCHA(NLCB,IDIM+2+I)=YC.YET(I)
229 : 104 continue
230 : MPRLI.VPOCHA(NLCB,IDIM+NSP+2)=KAC
231 : MPRLI.VPOCHA(NLCB,IDIM+NSP+3)=EPSC
232 : IF (IK0N .GT. 0) THEN
233 : MPRLI.VPOCHA(NLCB,IDIM+NSP+4)=K0C
234 : ENDIF
235 : C---------------------------------------------------
236 : C******* Probleme de Riemann entre l'etat gauche
237 : C RC,UNC,UTC,UT2C,PC et l'etat droite
238 : C RC,UNC,UTC,UT2C,PF
239 : C On utilise AUSM+
240 : C Flux dans le repaire normale
241 : C---------------------------------------------------
242 : NESP=NSP-1
243 : IF(IDIM.EQ.2)THEN
243 : CALL FAUSMP(NESP,
244 : & GAMC,RC,PC,UNC,UTC,
245 : & GAMC,RC,PF,UNC,UTC,
246 : & YC.YET,YC.YET,
247 : & FLUX2D.FU,
248 : & CELLT)
249 : C-------------------------------------------------------
250 : C******* Residuum (son SPG a le meme ordre que MELEFC)
251 : C-------------------------------------------------------
252 : MPRES.VPOCHA(IFAC,1)=-1*FLUX2D.FU(1)*SURF/VOLU
253 : MPRES.VPOCHA(IFAC,2)=-1*((FLUX2D.FU(2)*CNX)+
254 : & (FLUX2D.FU(3)*CTX))*SURF/VOLU
255 : MPRES.VPOCHA(IFAC,3)=-1*((FLUX2D.FU(2)*CNY)+
256 : & (FLUX2D.FU(3)*CTY))*SURF/VOLU
257 : MPRES.VPOCHA(IFAC,4)=-1*FLUX2D.FU(4)*SURF/VOLU
258 : do 105 i=1,(nsp-1)
259 : MPRES.VPOCHA(IFAC,4+I)=-1*FLUX2D.FU(4+I)*SURF/VOLU
260 : 105 continue
261 : MPRES.VPOCHA(IFAC,4+NSP)=-1*KAC*FLUX2D.FU(1)*SURF/VOLU
262 : MPRES.VPOCHA(IFAC,5+NSP)=-1*EPSC*FLUX2D.FU(1)*SURF/VOLU
263 : IF (IK0N .GT. 0) THEN
264 : MPRES.VPOCHA(IFAC,6+NSP)=-1*K0C*FLUX2D.FU(1)*SURF/VOLU
265 : ENDIF
266 : ELSE
266 : CALL FAUSM3(NESP,
267 : & GAMC,RC,PC,UNC,UTC,UT2C,
268 : & GAMC,RC,PF,UNC,UTC,UT2C,
269 : & YC.YET,YC.YET,
270 : & FLUX3D.FU,
271 : & CELLT)
272 : C------------------------------------------------------
273 : C******* Residuum (son SPG a le meme ordre que MELEFC)
274 : C------------------------------------------------------
275 : MPRES.VPOCHA(IFAC,1)=-1*FLUX3D.FU(1)*SURF/VOLU
276 : MPRES.VPOCHA(IFAC,2)=-1*((FLUX3D.FU(2)*CNX)+
277 : & (FLUX3D.FU(3)*CTX)+(FLUX3D.FU(4)*CT2X))*SURF/VOLU
278 : MPRES.VPOCHA(IFAC,3)=-1*((FLUX3D.FU(2)*CNY)+
279 : & (FLUX3D.FU(3)*CTY)+(FLUX3D.FU(4)*CT2Y))*SURF/VOLU
280 : MPRES.VPOCHA(IFAC,4)=-1*((FLUX3D.FU(2)*CNZ)+
281 : & (FLUX3D.FU(3)*CTZ)+(FLUX3D.FU(4)*CT2Z))*SURF/VOLU
282 : MPRES.VPOCHA(IFAC,5)=-1*FLUX3D.FU(5)*SURF/VOLU
283 : do 106 i=1,(nsp-1)
284 : MPRES.VPOCHA(IFAC,5+I)=-1*FLUX3D.FU(5+I)*SURF/VOLU
285 : 106 continue
286 : MPRES.VPOCHA(IFAC,5+NSP)=-1*KAC*FLUX3D.FU(1)*SURF/VOLU
287 : MPRES.VPOCHA(IFAC,6+NSP)=-1*EPSC*FLUX3D.FU(1)*SURF/VOLU
288 : IF (IK0N .GT. 0) THEN
289 : MPRES.VPOCHA(IFAC,7+NSP)=-1*K0C*FLUX3D.FU(1)*SURF/VOLU
290 : ENDIF
291 : ENDIF
292 : ENDDO
293 : C
294 : SEGDES MELEFC
295 : C
296 : SEGDES MLEMC
297 : SEGDES MLEMCB
298 : SEGDES MLEMF
299 : C
300 : SEGDES MPNORM
301 : SEGDES MPVOL
302 : SEGDES MPSURF
303 : SEGDES MPRC
304 : SEGDES MPPC
305 : SEGDES MPVC
306 : SEGDES MPYC
307 : SEGDES MPKAC
308 : SEGDES MPEPSC
309 : IF (IK0N .GT. 0) THEN
310 : SEGDES MPK0C
311 : ENDIF
312 : SEGDES MPLIM
313 : SEGDES MPRES
314 : SEGDES MPRLI
315 : SEGDES YC
316 : SEGDES FLUX2D
317 : SEGDES FLUX3D
318 : C
319 : 9999 CONTINUE
320 : RETURN
321 : END
322 :
323 :
324 :
325 :
326 :
327 :
328 :
329 :
330 :
331 :
© Cast3M 2003 - All rights reserved.
Disclaimer