1 : C CKON2 SOURCE PV 09/03/12 21:17:04 6325
2 : SUBROUTINE CKON2(LOGME,INDMET,
3 : & IROF,IVITF,IPF,IGAMF,IFRMAF,
4 : & ICHPSU,ICHPDI,
5 : & MELEMC,MELEMF,MELEFE,
6 : & IZG1,IZG2,IZG3,IZG4,DT,DIAMEL,NLCEMI,
7 : & LOGNC,LOGAN,MESERR)
8 : C************************************************************************
9 : C
10 : C PROJET : CASTEM 2000
11 : C
12 : C NOM : CKON2
13 : C
14 : C DESCRIPTION : Voir CKON
15 : C
16 : C Cas trois dimensions, gaz "thermally perfect"
17 : C
18 : C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
19 : C
20 : C AUTEUR : A. BECCANTINI, DRN/DMT/SEMT/TTMF
21 : C
22 : C************************************************************************
23 : C
24 : C
25 : C APPELES (Outils
26 : C CASTEM) : KRIPAD, LICHT
27 : C
28 : C APPELES (Calcul) : FLURIE, FLUXVL, FLUVLH, FLHUS1, FLHUS2, FLAUSM
29 : C
30 : C
31 : C************************************************************************
32 : C
33 : C ENTREES
34 : C
35 : C
36 : C 1) PARAMETRES
37 : C
38 : C LOGME : (LOGICAL); .TRUE. -> MULTI-ESPECES
39 : C .FALSE. -> MONO-ESPECE
40 : C
41 : C INDMET : 1 van Leer Hanel FVS
42 : C
43 : C 2 HUS
44 : C
45 : C 3 Godunov
46 : C
47 : C 2) Pointeurs des MCHAMLs
48 : C
49 : C IROF : MCHAML sur "FACEL" contenant la masse volumique
50 : C ("gauche" et "droite");
51 : C
52 : C IVITF : MCHAML sur "FACEL" contenant la vitesse dans le repaire
53 : C local (n,t) et les cosinus directeurs des repaire local;
54 : C
55 : C IPF : MCHAML sur "FACEL" contenant la pression;
56 : C
57 : C IGAMF : MCHAML sur "FACEL" contenant le gamma;
58 : C
59 : C IFRAMAF : MCHAML sur "FACEL", contenant les fractions massiques
60 : C si LOGME = .TRUE.;
61 : C LOGME = .FALSE. -> IFRAMAF = 0
62 : C
63 : C
64 : C 3) Pointeurs de CHPOINTs de la table DOMAINE
65 : C
66 : C ICHPSU : CHPOINT "FACE" contenant la surface des faces
67 : C
68 : C ICHPDI : CHPOINT "CENTRE" contenant le diametre minimum
69 : C de chaque element
70 : C
71 : C
72 : C 4) Pointeurs de MELEME de la table DOMAINE
73 : C
74 : C MELEMC : MELEME 'CENTRE' du SPG des CENTRES
75 : C
76 : C MELEMF : MELEME 'FACE' du SPG des FACES
77 : C
78 : C MELEFE : MELEME 'FACEL' du connectivité FACES -> ELEM
79 : C
80 : C SORTIES (il faudrait dire E/S)
81 : C
82 : C IZGi : pointeurs de CHPOINTs "FACE" dont les valeurs
83 : C se trouvent dans la table KIZX . 'EQEX' . 'KIZG'
84 : C aux indices 'IZGi'
85 : C
86 : C IZG1 : Increment de masse voluique
87 : C
88 : C IZG2 : Increment de quantite de mouvement
89 : C
90 : C IZG3 : Increment de l'energie totale
91 : C
92 : C IZG4 : Increment de les Masse Volumiques des Especies
93 : C (si LOGME = .TRUE.)
94 : C
95 : C
96 : C DIAMEL : 'minimum' diametre du maillage
97 : C
98 : C NLCEMI : numero local du CENTRE ou le diametre est 'minimum'
99 : C
100 : C DT : pas de temps pour le respect de la CFL-like condition
101 : C DT < DIAMEL /2 /max(Lambda_i)
102 : C En maillage regulier cette condition garantie la
103 : C non-interaction des ondes
104 : C
105 : C
106 : C LOGNC : (LOGICAL): si .TRUE. la methode de Newton-Rapson, utilisée
107 : C dans pour la solution du probleme Riemann exacte ou dans
108 : C l'algorithm HUS, n'a pas bien marchéee; MESERR = 'Goudunov'
109 : C ou 'HUS'.
110 : C
111 : C LOGAN : (LOGICAL): si .TRUE. une anomalie à été detectée
112 : C
113 : C MESERR : pour l'ecriture des messages d'erreurs
114 : C
115 : C************************************************************************
116 : C
117 : C HISTORIQUE (Anomalies et modifications éventuelles)
118 : C
119 : C HISTORIQUE :
120 : C
121 : C************************************************************************
122 : C
123 : C
124 : C N.B.: On suppose qu'on a déjà controllé RO, P > 0
125 : C GAMMA \in (1,3)
126 : C Y \in (0,1)
127 : C Si non il faut le faire!!!
128 : C
129 : C************************************************************************
130 : C
131 : C
132 : C**** Variables de COOPTIO
133 : C
134 : C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
135 : C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
136 : C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
137 : C & ,IECHO, IIMPI, IOSPI
138 : C & ,IDIM
139 : CC & ,MCOORD
140 : C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
141 : C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
142 : C & ,NORINC,NORVAL,NORIND,NORVAD
143 : C & ,NUCROU, IPSAUV
144 : C
145 : IMPLICIT INTEGER(I-N)
146 : INTEGER I1
147 : & ,INDMET
148 : & ,IROF,IVITF,IPF,IGAMF,IFRMAF
149 : & ,ICHPSU,ICHPDI,MELEMC,MELEMF,MELEFE
150 : & ,IGEOMC,IGEOMF
151 : & ,IZG1,IZG2,IZG3,IZG4,NLCEMI
152 : & ,NESP, NFAC
153 : & ,NLCF, NGCEG, NGCED, NLCEG, NLCED
154 : & ,NGCF, NLCF1, SPG1, SPG2
155 : REAL*8 DIAMEL, DT, UNSDT, CELLT
156 : & , ROG, UNG, UTG, UVG, PG, GAMG
157 : & , ROD, UND, UTD, UVD, PD, GAMD
158 : & , SURF,CNX, CNY, CNZ, CTX , CTY, CTZ
159 : & , CVX, CVY, CVZ
160 : & , CELL, DIAMG, DIAMD, DIAM
161 : & , ASON, LAMBDA
162 : LOGICAL LOGME, LOGNC, LOGAN
163 : CHARACTER*(40) MESERR
164 : CHARACTER*(8) TYPE
165 : C
166 : C**** LES INCLUDES
167 : C
168 : -INC CCOPTIO
169 : -INC SMCOORD
170 : -INC SMCHAML
171 : POINTEUR MELVNX.MELVAL, MELVNY.MELVAL,MELVNZ.MELVAL,
172 : & MELT1X.MELVAL, MELT1Y.MELVAL,MELT1Z.MELVAL,
173 : & MELT2X.MELVAL, MELT2Y.MELVAL,MELT2Z.MELVAL
174 : POINTEUR MELVUN.MELVAL, MELVUT.MELVAL, MELVUV.MELVAL
175 : POINTEUR MELRO.MELVAL, MELP.MELVAL,
176 : & MELGAM.MELVAL
177 : -INC SMCHPOI
178 : POINTEUR MPOVSU.MPOVAL, MPOVDI.MPOVAL
179 : & , MPOVG1.MPOVAL, MPOVG2.MPOVAL
180 : & , MPOVG3.MPOVAL, MPOVG4.MPOVAL
181 : POINTEUR MCHAMY.MCHAML
182 : -INC SMELEME
183 : -INC SMLMOTS
184 : -INC SMLENTI
185 : C
186 : C**** Les fractiones massiques.
187 : C
188 : SEGMENT FRAMAS
189 : REAL*8 YET(NESP)
190 : ENDSEGMENT
191 : POINTEUR FRAMAG.FRAMAS, FRAMAD.FRAMAS
192 : C
193 : C**** Les flux aux interface dans le repaire (n,t,v)
194 : C
195 : SEGMENT IFLUX
196 : REAL*8 FLUX(NESP+5)
197 : ENDSEGMENT
198 : POINTEUR IFLU1.IFLUX, IFLU2.IFLUX
199 : C
200 : C
201 : C**** Initialisation des MCHAMLs
202 : C
203 : C**** Masse volumique
204 : C
205 : MCHEL1 = IROF
206 : SEGACT MCHEL1
207 : MCHAM1 = MCHEL1.ICHAML(1)
208 : SEGACT MCHAM1
209 : MELRO = MCHAM1.IELVAL(1)
210 : SEGDES MCHEL1
211 : SEGDES MCHAM1
212 : C
213 : C**** Pression
214 : C
215 : MCHEL1 = IPF
216 : SEGACT MCHEL1
217 : MCHAM1 = MCHEL1.ICHAML(1)
218 : SEGACT MCHAM1
219 : MELP = MCHAM1.IELVAL(1)
220 : SEGDES MCHEL1
221 : SEGDES MCHAM1
222 : C
223 : C**** Gamma
224 : C
225 : MCHEL1 = IGAMF
226 : SEGACT MCHEL1
227 : MCHAM1 = MCHEL1.ICHAML(1)
228 : SEGACT MCHAM1
229 : MELGAM = MCHAM1.IELVAL(1)
230 : SEGDES MCHEL1
231 : SEGDES MCHAM1
232 : C
233 : C**** Vitesse et cosinus directeurs du repere (n,t)
234 : C
235 : MCHEL1 = IVITF
236 : SEGACT MCHEL1
237 : C
238 : C**** La vitesse a comme SPG MELEFE
239 : C Le cosinus directeurs ont comme SPG MELEMF
240 : C
241 : C MCHAM1 -> Cosinus directeurs
242 : C MCHAM2 -> Vitesse
243 : C
244 : SPG1 = MCHEL1.IMACHE(1)
245 : SPG2 = MCHEL1.IMACHE(2)
246 : IF((SPG1 .EQ. MELEMF) .AND. (SPG2 .EQ. MELEFE))THEN
247 : MCHAM1 = MCHEL1.ICHAML(1)
248 : MCHAM2 = MCHEL1.ICHAML(2)
249 : ELSEIF((SPG1 .EQ. MELEFE) .AND. (SPG2 .EQ. MELEMF))THEN
250 : MCHAM1 = MCHEL1.ICHAML(2)
251 : MCHAM2 = MCHEL1.ICHAML(1)
252 : ELSE
253 : LOGAN = .TRUE.
254 : GOTO 9999
255 : ENDIF
256 : SEGACT MCHAM1
257 : MELVNX = MCHAM1.IELVAL(1)
258 : MELVNY = MCHAM1.IELVAL(2)
259 : MELVNZ = MCHAM1.IELVAL(3)
260 : MELT1X = MCHAM1.IELVAL(4)
261 : MELT1Y = MCHAM1.IELVAL(5)
262 : MELT1Z = MCHAM1.IELVAL(6)
263 : MELT2X = MCHAM1.IELVAL(7)
264 : MELT2Y = MCHAM1.IELVAL(8)
265 : MELT2Z = MCHAM1.IELVAL(9)
266 : SEGDES MCHAM1
267 : SEGACT MCHAM2
268 : MELVUN = MCHAM2.IELVAL(1)
269 : MELVUT = MCHAM2.IELVAL(2)
270 : MELVUV = MCHAM2.IELVAL(3)
271 : SEGDES MCHAM2
272 : SEGDES MCHEL1
273 : C
274 : C**** Fractions massiques
275 : C
276 : IF(LOGME)THEN
277 : MCHEL1 = IFRMAF
278 : SEGACT MCHEL1
279 : MCHAMY = MCHEL1.ICHAML(1)
280 : SEGACT MCHAMY
281 : C
282 : C******* Numero d'especes dans les equations d'Euler
283 : C
284 : NESP = MCHAMY.IELVAL(/1)
285 : DO I1 = 1, NESP
286 : MELVA1 = MCHAMY.IELVAL(I1)
287 : SEGACT MELVA1
288 : ENDDO
289 : SEGINI FRAMAG
290 : SEGINI FRAMAD
291 : SEGDES MCHEL1
292 : ELSE
293 : C
294 : C******* Definition minimale de YET, necessaire pour transmetre YET aux
295 : C subroutines FORTRAN qui calculent les flux
296 : C
297 : NESP = 1
298 : SEGINI FRAMAG
299 : SEGINI FRAMAD
300 : NESP = 0
301 : ENDIF
302 : C
303 : C**** Initialisation des MELEMEs
304 : C
305 : C 'CENTRE', 'FACEL'
306 : C
307 : IPT2 = MELEFE
308 : SEGACT IPT2
309 : NFAC = IPT2.NUM(/2)
310 : C
311 : C**** KRIPAD pour la correspondance global/local de centre
312 : C
312 : CALL KRIPAD(MELEMC,MLENT1)
313 : C
314 : C**** MLENTI1 a MCORD.XCOORD(/1)/(IDIM+1) elements
315 : C
316 : C Si i est le numero global d'un noeud de ICEN,
317 : C MLENT1.LECT(i) contient sa position, i.e.
318 : C
319 : C I = numero global du noeud centre
320 : C MLENT1.LECT(i) = numero local du noeud centre
321 : C
322 : C MLENT1 déjà activé, i.e.
323 : C
324 : C SEGACT MLENT1
325 : C
326 : C
327 : C**** KRIPAD pour la correspondance global/local de 'FACE'
328 : C
328 : CALL KRIPAD(MELEMF,MLENT2)
329 : C
330 : C**** Initialisation de flux
331 : C
332 : SEGINI IFLU1
333 : SEGINI IFLU2
334 : C
335 : C**** IFLU2 = segment de travail en FLUVLH; c'est plus rapide le definir ici
336 : C
337 : C
338 : C**** CHPOINTs de la table DOMAINE
339 : C
339 : CALL LICHT(ICHPSU,MPOVSU,TYPE,IGEOMF)
339 : CALL LICHT(ICHPDI,MPOVDI,TYPE,IGEOMC)
340 : C
341 : C**** LICHT active les MPOVALs en *MOD
342 : C
343 : C i.e.
344 : C
345 : C SEGACT MPOVSU*MOD
346 : C SEGACT MPOVDI*MOD
347 : C
348 : C
349 : C**** Les FLUX aux face
350 : C
351 : C La densité
352 : C
352 : CALL LICHT(IZG1,MPOVG1,TYPE,IGEOMF)
353 : C
354 : C SEGACT MPOVG1*MOD
355 : C
356 : C**** Les debits
357 : C
357 : CALL LICHT(IZG2,MPOVG2,TYPE,IGEOMF)
358 : C
359 : C SEGACT MPOVG2*MOD
360 : C
361 : C**** L'energie totale volumique
362 : C
362 : CALL LICHT(IZG3,MPOVG3,TYPE,IGEOMF)
363 : C
364 : C SEGACT MPOVG3*MOD
365 : C
366 : C**** Les Fractions Massiques
367 : C
368 : IF(LOGME)THEN
368 : CALL LICHT(IZG4,MPOVG4,TYPE,IGEOMF)
369 : C
370 : C SEGACT MPOVG4*MOD
371 : C
372 : ENDIF
373 : C
374 : C**** Activation des MCHAMLs
375 : C
376 : SEGACT MELRO
377 : SEGACT MELP
378 : SEGACT MELGAM
379 : SEGACT MELVUN
380 : SEGACT MELVUT
381 : SEGACT MELVUV
382 : SEGACT MELVNX
383 : SEGACT MELVNY
384 : SEGACT MELVNZ
385 : SEGACT MELT1X
386 : SEGACT MELT1Y
387 : SEGACT MELT1Z
388 : SEGACT MELT2X
389 : SEGACT MELT2Y
390 : SEGACT MELT2Z
391 : C
392 : C**** Initialisation de 1/DT
393 : C
394 : UNSDT = 0.0D0
395 : C
396 : C**** BOUCLE SUR FACEL pour le calcul du FLUX
397 : C
398 : DO NLCF = 1, NFAC
399 : C
400 : C******* NLCF = numero local du centre de facel
401 : C NGCF = numero global du centre de facel
402 : C NLCF1 = numero local du centre de face
403 : C NGCEG = numero global du centre ELT "gauche"
404 : C NLCEG = numero local du centre ELT "gauche"
405 : C NGCED = numero global du centre ELT "droite"
406 : C NLCED = numero local du centre ELT "droite"
407 : C
408 : NGCEG = IPT2.NUM(1,NLCF)
409 : NGCED = IPT2.NUM(3,NLCF)
410 : NGCF = IPT2.NUM(2,NLCF)
411 : NLCF1 = MLENT2.LECT(NGCF)
412 : NLCEG = MLENT1.LECT(NGCEG)
413 : NLCED = MLENT1.LECT(NGCED)
414 : C
415 : C******* NLCF != NLCF1 -> l'auteur (MOI) n'a rien compris.
416 : C
417 : IF(NLCF .NE. NLCF1)THEN
418 : MESERR = 'FACEL et FACE = ? '
419 : LOGAN = .TRUE.
420 : GOTO 9999
421 : ENDIF
422 : C
423 : C******* Recuperation des Etats "gauche" et "droite"
424 : C
425 : ROG = MELRO.VELCHE(1,NLCF)
426 : UNG = MELVUN.VELCHE(1,NLCF)
427 : UTG = MELVUT.VELCHE(1,NLCF)
428 : UVG = MELVUV.VELCHE(1,NLCF)
429 : PG = MELP.VELCHE(1,NLCF)
430 : GAMG = MELGAM.VELCHE(1,NLCF)
431 : C
432 : ROD = MELRO.VELCHE(3,NLCF)
433 : UND = MELVUN.VELCHE(3,NLCF)
434 : UTD = MELVUT.VELCHE(3,NLCF)
435 : UVD = MELVUV.VELCHE(3,NLCF)
436 : PD = MELP.VELCHE(3,NLCF)
437 : GAMD = MELGAM.VELCHE(3,NLCF)
438 : C
439 : CNX = MELVNX.VELCHE(1,NLCF)
440 : CNY = MELVNY.VELCHE(1,NLCF)
441 : CNZ = MELVNZ.VELCHE(1,NLCF)
442 : CTX = MELT1X.VELCHE(1,NLCF)
443 : CTY = MELT1Y.VELCHE(1,NLCF)
444 : CTZ = MELT1Z.VELCHE(1,NLCF)
445 : CVX = MELT2X.VELCHE(1,NLCF)
446 : CVY = MELT2Y.VELCHE(1,NLCF)
447 : CVZ = MELT2Z.VELCHE(1,NLCF)
448 : C
449 : C******* Le fractiones massiques
450 : C
451 : IF(LOGME)THEN
452 : DO I1 = 1, NESP
453 : MELVA1 = MCHAMY.IELVAL(I1)
454 : FRAMAG.YET(I1) = MELVA1.VELCHE(1,NLCF)
455 : FRAMAD.YET(I1) = MELVA1.VELCHE(3,NLCF)
456 : ENDDO
457 : ENDIF
458 : C
459 : C******* On a defini (ROg,ROUNg,ROUTg,Pg,(Yg)), (ROd,ROUNd,ROUTd,Pd,(Yd))
460 : C et on a déjà verifié ROg, ROd, Pg, Pd > 0 et 0FLURI2(NESP,
470 : & GAMG,ROG,PG,UNG,UTG,UVG,
471 : & GAMD,ROD,PD,UND,UTD,UVD,
472 : & FRAMAG.YET,FRAMAD.YET,
473 : & IFLU1.FLUX,
474 : & CELLT,
475 : & LOGNC,LOGAN,MESERR)
476 : C
477 : ELSEIF(INDMET .EQ. 2)THEN
478 : C
479 : C******* Van Leer FVS
480 : C
481 : C N.B: FLUXVL en FORTRAN pure
482 : C FRAMAG.YET = table d'un pointeur -> table
483 : C La meme chose pour FRAMAD.YET, IFLU1.FLUX,
484 : C IFLU2.FLUX
485 : C
485 : CALL FLUXV2(NESP,
486 : & GAMG,ROG,PG,UNG,UTG,UVG,
487 : & GAMD,ROD,PD,UND,UTD,UVD,
488 : & FRAMAG.YET,FRAMAD.YET,
489 : & IFLU1.FLUX,IFLU2.FLUX,
490 : & CELLT)
491 : ELSEIF(INDMET .EQ. 3)THEN
492 : C
493 : C******* Van Leer - Hanel FVS
494 : C
495 : C N.B: FLUVLH en FORTRAN pure
496 : C FRAMAG.YET = table d'un pointeur -> table
497 : C La meme chose pour FRAMAD.YET, IFLU1.FLUX,
498 : C IFLU2.FLUX
499 : C
499 : CALL FLUVL2(NESP,
500 : & GAMG,ROG,PG,UNG,UTG,UVG,
501 : & GAMD,ROD,PD,UND,UTD,UVD,
502 : & FRAMAG.YET,FRAMAD.YET,
503 : & IFLU1.FLUX,IFLU2.FLUX,
504 : & CELLT)
505 : ELSEIF(INDMET .EQ. 4)THEN
506 : C
507 : C******* HUS (Van Leer FVS + Osher FDS)
508 : C
508 : CALL FLHU21(NESP,
509 : & GAMG,ROG,PG,UNG,UTG,UVG,
510 : & GAMD,ROD,PD,UND,UTD,UVD,
511 : & FRAMAG.YET,FRAMAD.YET,
512 : & IFLU1.FLUX,IFLU2.FLUX,
513 : & CELLT,
514 : & LOGNC,MESERR,LOGAN)
515 : ELSEIF(INDMET .EQ. 5)THEN
516 : C
517 : C******* HUS (Van Leer - Hanel FVS + Osher FDS)
518 : C
518 : CALL FLHU22(NESP,
519 : & GAMG,ROG,PG,UNG,UTG,UVG,
520 : & GAMD,ROD,PD,UND,UTD,UVD,
521 : & FRAMAG.YET,FRAMAD.YET,
522 : & IFLU1.FLUX,IFLU2.FLUX,
523 : & CELLT,
524 : & LOGNC,MESERR,LOGAN)
525 : ELSEIF(INDMET .EQ. 6)THEN
526 : C
527 : C******** AUSM
528 : C
528 : C CALL FLAUSM(NESP,
529 : C & GAMG,ROG,PG,UNG,UTG,
530 : C & GAMD,ROD,PD,UND,UTD,
531 : C & FRAMAG.YET,FRAMAD.YET,
532 : C & IFLU1.FLUX,IFLU2.FLUX,
533 : C & CELLT)
533 : CALL ERREUR(251)
534 : ENDIF
535 : C
536 : IF(LOGAN) GOTO 9999
537 : IF(LOGNC) GOTO 9999
538 : C
539 : C******* Ecriture des flux
540 : C
541 : C FLUX(1) = RO Un RO Un
542 : C FLUX(2) = RO Un Un + P -> RO Un Ux + P CNX
543 : C FLUX(3) = RO Un Ut -> RO Un Uy + P CNY
544 : C FLUX(4) = RO Un Et RO Un Et
545 : C
546 : SURF = MPOVSU.VPOCHA(NLCF,1)
547 : MPOVG1.VPOCHA(NLCF,1) = MPOVG1.VPOCHA(NLCF,1) +
548 : & (IFLU1.FLUX(1) * SURF )
549 : MPOVG2.VPOCHA(NLCF,1) = MPOVG2.VPOCHA(NLCF,1) +
550 : &((IFLU1.FLUX(2)*CNX+IFLU1.FLUX(3)*CTX+IFLU1.FLUX(4)*CVX) * SURF)
551 : MPOVG2.VPOCHA(NLCF,2) = MPOVG2.VPOCHA(NLCF,2) +
552 : &((IFLU1.FLUX(2)*CNY+IFLU1.FLUX(3)*CTY+IFLU1.FLUX(4)*CVY) * SURF)
553 : MPOVG2.VPOCHA(NLCF,3) = MPOVG2.VPOCHA(NLCF,3) +
554 : &((IFLU1.FLUX(2)*CNZ+IFLU1.FLUX(3)*CTZ+IFLU1.FLUX(4)*CVZ) * SURF)
555 : MPOVG3.VPOCHA(NLCF,1) = MPOVG3.VPOCHA(NLCF,1) +
556 : & (IFLU1.FLUX(5) * SURF)
557 : IF(LOGME)THEN
558 : DO I1 = 1, NESP
559 : MPOVG4.VPOCHA(NLCF,I1)=IFLU1.FLUX(5+I1)
560 : & * SURF
561 : ENDDO
562 : ENDIF
563 : C
564 : C******* Calcul du pas du temps (CFL)
565 : C
566 : C****** a) etat a l'interface
567 : C
568 : DIAMG = MPOVDI.VPOCHA(NLCEG,1)
569 : DIAMD = MPOVDI.VPOCHA(NLCED,1)
570 : DIAM = (DIAMG+DIAMD)/2.0D0
571 : CELL = 1.0D0/DIAM/CELLT
572 : IF(CELL .GT. UNSDT)THEN
573 : UNSDT = CELL
574 : DIAMEL = DIAM
575 : NLCEMI = NLCEG
576 : ENDIF
577 : C
578 : C****** b) etat gauche
579 : C
580 : ASON = SQRT(GAMG*PG/ROG)
581 : LAMBDA = ABS(UNG) + ASON
582 : CELL = LAMBDA / DIAM
583 : IF(CELL .GT. UNSDT)THEN
584 : UNSDT = CELL
585 : DIAMEL = DIAM
586 : NLCEMI = NLCEG
587 : ENDIF
588 : C
589 : C****** C) etat droite
590 : C
591 : ASON = SQRT(GAMD*PD/ROD)
592 : LAMBDA = ABS(UND) + ASON
593 : CELL = LAMBDA / DIAM
594 : IF(CELL .GT. UNSDT)THEN
595 : UNSDT = CELL
596 : DIAMEL = DIAM
597 : NLCEMI = NLCED
598 : ENDIF
599 : C
600 : C
601 : C**** Fin boucle sur FACEL
602 : C
603 : ENDDO
604 : C
605 : C**** Pas du temps (condition de non interaction en 1D)
606 : C
607 : DT = 0.5D0 / UNSDT
608 : C
609 : C**** Desactivation des segments et
610 : C on detruit les MCHAMLs
611 : C
612 : C
613 : C**** SEGSUP FRAMAG
614 : C SEGSUP FRAMAD
615 : C
616 : C meme si LOGME = .FALSE.
617 : C
618 : SEGSUP FRAMAG
619 : SEGSUP FRAMAD
620 : C
621 : SEGSUP MLENT1
622 : SEGDES MLENT2
623 : SEGDES IPT2
624 : C
625 : SEGSUP IFLU1
626 : SEGSUP IFLU2
627 : C
628 : SEGDES MPOVSU
629 : SEGDES MPOVDI
630 : C
631 : SEGDES MPOVG1
632 : SEGDES MPOVG2
633 : SEGDES MPOVG3
634 : C
635 : SEGDES MELRO
636 : SEGDES MELP
637 : SEGDES MELGAM
638 : SEGDES MELVUN
639 : SEGDES MELVUT
640 : SEGDES MELVUV
641 : SEGDES MELVNX
642 : SEGDES MELVNY
643 : SEGDES MELVNZ
644 : SEGDES MELT1X
645 : SEGDES MELT1Y
646 : SEGDES MELT1Z
647 : SEGDES MELT2X
648 : SEGDES MELT2Y
649 : SEGDES MELT2Z
650 : C
651 : IF(LOGME) THEN
652 : DO I1 = 1, NESP
653 : MELVA1 = MCHAMY.IELVAL(I1)
654 : SEGDES MELVA1
655 : ENDDO
656 : SEGDES MPOVG4
657 : C
658 : SEGDES MCHAMY
659 : ENDIF
660 : CC
661 : 9999 CONTINUE
662 : C
663 : RETURN
664 : END
665 : C
666 :
667 :
668 :
669 :
670 :
671 :
672 :
673 :
674 :
675 :
© Cast3M 2003 - All rights reserved.
Disclaimer