1 : C KONV15 SOURCE BECC 11/05/26 21:15:51 6981
2 : SUBROUTINE KONV15
3 : C************************************************************************
4 : C
5 : C PROJET : CASTEM 2000
6 : C
7 : C NOM : KONV15
8 : C
9 : C DESCRIPTION : Subroutine appellée par KONV1
10 : C
11 : C Modelisation 2D/3D des equations d'Euler.
12 : C Ghost Fluid Method for the poor.
13 : C
14 : C Calcul du residu / DELTAT
15 : C
16 : C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
17 : C
18 : C AUTEUR : A. BECCANTINI, DEN/DM2S/SFME/LTMF
19 : C
20 : C************************************************************************
21 : C
22 : C APPELES (Calcul) : KGFM12 (2D, GFMP)
23 : C
24 : C************************************************************************
25 : C
26 : C*** SINTAXE
27 : C
28 : C Discrétisation en VF "cell-centered" des équations d'Euler pour
29 : C un "stiffened" gas. Methode GFMP.
30 : C
31 : C Inconnues: phi, densité, quantité de mouvement, énergie totale par
32 : C unité de volume (variables conservatives), densité et fractions
33 : C volumiques des constituants.
34 : C
35 : C
36 : C RCHPO1 RFLOT1 = 'KONV' 'VF' 'GFMP' MOT1 MOT2 MOD1
37 : C TABG
38 : C LMOT1 MCHAPH MCHAR MCHAV MCHAP MCHAY
39 : C MCHAA MCHAY MCHPPH LOG1 MAILLIM ;
40 : C ENTREES
41 : C
42 : C
43 : C MOT1 : objet de type MOT
44 : C Il vaut 'RESI' si on veut calculer le résidu
45 : C
46 : C MOT2 : objet de type MOT
47 : C Il indique la méthode de décentrement:
48 : C 'GODUNOV'
49 : C
50 : C MOD1 : objet modele de type Euler
51 : C
52 : C TABG : objet de type TABLE
53 : C il contient les proprietes du gaz:
54 : C
55 : C LMOT1 : objet de type LISTMOTS
56 : C Noms de composantes du résultat (RCHPO1)
57 : C Il contient dans l'ordre suivant les noms de
58 : * phi, de la densités, de la vitesse, de l'énergie totale
59 : * par unité de volume, des densités des espèces, des
60 : C fractions volumiques.
61 : C
62 : C MCHAPH : MCHAML contenant la function phi,
63 : C qui a comme SPG (support géométrique) l'indice 'FACEL' de la
64 : C table associée à MOD1 (une composante, 'SCAL')
65 : C
66 : C MCHAR : MCHAML contenant la masse volumique,
67 : C même SPG que MCHAA1, une composante, 'SCAL'
68 : C
69 : C MCHAV : MCHAML contenant la vitesse et les cosinus
70 : C directeurs du repère locale (n,t) dans le repère
71 : C global (x,y), même SPG que MCHAA1,
72 : C (dans le cas 2D 6 composantes:
73 : C * 'UN' = vitesse normale (SPG =('DOMA' MOD1 'FACEL'))
74 : C * 'UT' = vitesse tangentielle (SPG =('DOMA' MOD1 'FACEL'))
75 : C * 'NX' = n.x (SPG = 'FACE')
76 : C * 'NY' = n.y (SPG = 'FACE')
77 : C * 'TX' = t.x (SPG = 'FACE')
78 : C * 'TY' = t.y (SPG = 'FACE')).
79 : C
80 : C MCHAP : MCHAML (SPG =('DOMA' MOD1 'FACEL')) contenant la pression
81 : C (une seule composante, 'SCAL').
82 : C
83 : C MCHAY : MCHAML (SPG =('DOMA' MOD1 'FACEL')) contenant les fractions
84 : C massiques (composantes dans TABG . 'ESPEULE').
85 : C
86 : C MCHAA : MCHAML (SPG =('DOMA' MOD1 'FACEL')) contenant les fractions
87 : C volumiques (composantes dans TABG . 'ESPEULE').
88 : C
89 : C MCHPPH : CHPO contenant phi,
90 : C qui a comme SPG (support géométrique) l'indice 'CENTRE' de la
91 : C table associée à MOD1 (une composante, 'SCAL')
92 : C
93 : C MCHPPH : CHPO contenant la fraction volumique alpha de la phase 1,
94 : C qui a comme SPG (support géométrique) l'indice 'CENTRE' de la
95 : C table associée à MOD1 (une composante, 'SCAL')
96 : C
97 : C LOG1 : LOGIQUE, si VRAI phi et les fractions volumiques sont
98 : C traités avec une approche conservative
99 : C
100 : C MAILLIM : MAILLAGE -- describes the mesh where the flux is not
101 : C determined; it will be found by using
102 : C the subroutins for the Boundary Conditions
103 : C
104 : C SORTIES
105 : C
106 : C RCHPO1 : objet de type CHPOINT (composantes = LMOT1)
107 : C Residu si MOT2 = 'RESI' (SPG =('DOMA' MOD1 'CENTRE'))
108 : C
109 : C RFLOT1 : objet de type FLOTTANT
110 : C Il est le temps caracteristique associé à l'onde la plus
111 : C rapide.
112 : C
113 : C Remarque
114 : C --------
115 : C
116 : C RCHPO1 est égal à:
117 : C * la derivé temporelle des inconnues si l'option 'RESI' est utilisée
118 : C
119 : C
120 : C***********************************************************************
121 : C
122 : C************************************************************************
123 : C
124 : C HISTORIQUE (Anomalies et modifications éventuelles)
125 : C
126 : C 04/12/2010 - Created
127 : * 25/05/2011 - Evolution in CAST3M
128 : C
129 : C************************************************************************
130 : C
131 : IMPLICIT INTEGER(I-N)
132 : C
133 : -INC CCOPTIO
134 : -INC SMLMOTS
135 : POINTEUR MLMVIT.MLMOTS, MLMESP.MLMOTS
136 : -INC SMELEME
137 : -INC SMLREEL
138 : POINTEUR MLRMGA.MLREEL, MLRPGA.MLREEL,
139 : & MLRMPI.MLREEL, MLRPPI.MLREEL
140 : C
141 : INTEGER NESP, NESP1, IPGAS
142 : & , IDOMA, MELEMC, MELEMF, MELEFE, ICHPSU, ICHPDI , ICHPVO
143 : & , INORM, MELLIM, IFLIM
144 : & , NBMET, INDMET, IRET
145 : & , JGM, JGN
146 : & , INDIC, NBCOMP
147 : & , IPHI1
148 : & , IPHIF, IROF1, IVITF1, IPF1
149 : & , NINC, ILIINC, NC, ICELL
150 : & , ICHRES, INEFMD, ICOND, MMODEL
151 : & , ITOTO, IFRMAF, IFRALF, IALC
152 : C
153 : PARAMETER (NBMET=1)
154 : REAL*8 DT, PMIN
155 : CHARACTER*8 LMETO(NBMET), TYPE, MTYPI
156 : CHARACTER*4 LFLUX(1), MOT1(1)
157 : CHARACTER*(40) MESERR
158 : LOGICAL LOGNC, LOGAN, LOGCON
159 : C
160 : C**** Variables en ACCTAB
161 : C
162 : INTEGER IVALI, IRETI,IVALR, IRETR
163 : REAL*8 XVALI,XVALR
164 : LOGICAL LOGII, LOGIR
165 : CHARACTER*(8) CHARR
166 : C
167 : DATA LMETO/'GODUNOV '/
168 : DATA LFLUX/'RESI'/
169 : C
170 : C**** Initialisation des variables pour la gestion des erreurs.
171 : C
172 : LOGNC = .FALSE.
173 : LOGAN = .FALSE.
174 : MESERR = ' '
175 : C
176 : C******* Flux ou residu???
177 : C
177 : CALL LIRMOT(LFLUX,1,ICELL,1)
178 : IF(IERR .NE. 0)GOTO 9999
179 : IF(ICELL .NE. 1)THEN
180 : C LOGRES = .TRUE.
181 : C ELSE
182 : C
183 : C******** Message d'erreur standard
184 : C 251 2
185 : C Tentative d'utilisation d'une option non implémentée
186 : C
186 : CALL ERREUR(251)
187 : ENDIF
188 : C
189 : C**** Metode utilisée
190 : C
190 : CALL LIRMOT(LMETO,NBMET,INDMET,1)
191 : IF(IERR .NE. 0)GOTO 9999
192 : IF(INDMET .EQ. 0)THEN
193 : C
194 : C******** Message d'erreur standard
195 : C 251 2
196 : C Tentative d'utilisation d'une option non implémentée
197 : C
197 : CALL ERREUR(251)
198 : ENDIF
199 : C********************************
200 : C**** La table IPGAZ *******
201 : C********************************
202 : C
203 : C write(*,*) 'Son qui prima di gas'
204 : C
205 : C
206 : C**** Initialisation des variables en ACCTAB
207 : C
208 : IVALI = 0
209 : IVALR = 0
210 : XVALI = 0.0D0
211 : XVALR = 0.0D0
212 : LOGII = .FALSE.
213 : LOGIR = .FALSE.
214 : IRETI = 0
215 : IRETR = 0
216 : CHARR = ' '
217 : C
218 : C**************************************************
219 : C**** Lecture de la table des proprietes du gaz ***
220 : C**************************************************
221 : C
222 : ICOND = 1
222 : CALL QUETYP(TYPE,ICOND,IRETOU)
223 : IF(IERR .NE. 0)GOTO 9999
224 : IF(TYPE .NE. 'TABLE ')THEN
225 : C
226 : C******* Message d'erreur standard
227 : C 37 2
228 : C On ne trouve pas d'objet de type %m1:8
229 : C
230 : MOTERR(1:8) = 'TABLE '
230 : CALL ERREUR(37)
231 : GOTO 9999
232 : ELSE
233 : ICOND = 1
233 : CALL LIROBJ(TYPE,IPGAS,ICOND,IRETOU)
234 : IF(IERR .NE. 0)GOTO 9999
235 : ENDIF
236 : C
237 : C**** Nom de l'espece qui n'est pas dans les equations d'Euler
238 : C
239 : MTYPI = 'MOT '
240 : TYPE = ' '
240 : CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,'ESPNEULE', LOGII,IRETI,
241 : & TYPE,IVALR,XVALR ,CHARR,LOGIR,IRETR)
242 : IF((IERR .NE. 0) .OR. (TYPE .NE. 'MOT ')) THEN
243 : C
244 : C******* Message d'erreur standard
245 : C -301 0 %m1:40
246 : C
247 : MOTERR = 'TAB1 . ESPNEULE = ??? '
248 : WRITE(IOIMP,*) MOTERR(1:40)
249 : C
250 : C********** Message d'erreur standard
251 : C 21 2
252 : C Données incompatibles
253 : C
253 : CALL ERREUR(21)
254 : GOTO 9999
255 : ENDIF
256 : C
257 : C**** Les especes qui sont dans les Equations d'Euler
258 : C
259 : TYPE = ' '
259 : CALL ACMO(IPGAS,'ESPEULE',TYPE,MLMESP)
260 : IF(TYPE .NE. 'LISTMOTS')THEN
261 : C
262 : C******* Message d'erreur standard
263 : C -301 0 %m1:40
264 : C
265 : MOTERR(1:40) = 'TAB1 . ESPEULE = ??? '
266 : WRITE(IOIMP,*) MOTERR(1:40)
267 : C
268 : C******* Message d'erreur standard
269 : C 21 2
270 : C Données incompatibles
271 : C
271 : CALL ERREUR(21)
272 : GOTO 9999
273 : ENDIF
274 : SEGACT MLMESP
275 : NESP = MLMESP.MOTS(/2)
276 : SEGDES MLMESP
277 : C
278 : C**** List de gamma, PHI < 0 (MLRMGA, MLRrel Minus GAMMA)
279 : C
280 : MTYPI = 'MOT '
281 : TYPE = ' '
281 : CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,'MGAM', LOGII,IRETI,
282 : & TYPE,IVALR,XVALR ,CHARR,LOGIR,IRETR)
283 : IF((IERR .NE. 0) .OR. (TYPE .NE. 'LISTREEL')) THEN
284 : C
285 : C********** Message d'erreur standard
286 : C -301 0 %m1:40
287 : C
288 : MOTERR = ' TAB1 . MGAM = ??? '
289 : WRITE(IOIMP,*) MOTERR
290 : C
291 : C********** Message d'erreur standard
292 : C 21 2
293 : C Données incompatibles
294 : C
294 : CALL ERREUR(21)
295 : GOTO 9999
296 : ENDIF
297 : MLRMGA = IRETR
298 : SEGACT MLRMGA
299 : NESP1 = MLRMGA.PROG(/1)
300 : IF(NESP1 .NE. (NESP + 1))THEN
301 : C
302 : C********** Message d'erreur standard
303 : C -301 0 %m1:40
304 : C
305 : MOTERR = 'DIME(TAB1.MGAM) != NESP '
306 : WRITE(IOIMP,*) MOTERR(1:40)
307 : C
308 : C********** Message d'erreur standard
309 : C 21 2
310 : C Données incompatibles
311 : C
311 : CALL ERREUR(21)
312 : GOTO 9999
313 : ENDIF
314 : C
315 : C**** List de gamma, PHI > 0 (MLRPGA, MLRrel Plus GAMMA)
316 : C
317 : MTYPI = 'MOT '
318 : TYPE = ' '
318 : CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,'PGAM', LOGII,IRETI,
319 : & TYPE,IVALR,XVALR ,CHARR,LOGIR,IRETR)
320 : IF((IERR .NE. 0) .OR. (TYPE .NE. 'LISTREEL')) THEN
321 : C
322 : C********** Message d'erreur standard
323 : C -301 0 %m1:40
324 : C
325 : MOTERR = ' TAB1 . PGAM = ??? '
326 : WRITE(IOIMP,*) MOTERR
327 : C
328 : C********** Message d'erreur standard
329 : C 21 2
330 : C Données incompatibles
331 : C
331 : CALL ERREUR(21)
332 : GOTO 9999
333 : ENDIF
334 : MLRPGA = IRETR
335 : SEGACT MLRPGA
336 : NESP1 = MLRPGA.PROG(/1)
337 : IF(NESP1 .NE. (NESP + 1))THEN
338 : C
339 : C********** Message d'erreur standard
340 : C -301 0 %m1:40
341 : C
342 : MOTERR = 'DIME(TAB1.PGAM) != NESP '
343 : WRITE(IOIMP,*) MOTERR(1:40)
344 : C
345 : C********** Message d'erreur standard
346 : C 21 2
347 : C Données incompatibles
348 : C
348 : CALL ERREUR(21)
349 : GOTO 9999
350 : ENDIF
351 : C
352 : C**** List de PINF, PHI < 0 (MLRMPI)
353 : C
354 : MTYPI = 'MOT '
355 : TYPE = ' '
355 : CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,'MPIN', LOGII,IRETI,
356 : & TYPE,IVALR,XVALR ,CHARR,LOGIR,IRETR)
357 : IF((IERR .NE. 0) .OR. (TYPE .NE. 'LISTREEL')) THEN
358 : C
359 : C********** Message d'erreur standard
360 : C -301 0 %m1:40
361 : C
362 : MOTERR = ' TAB1 . MPIN = ??? '
363 : WRITE(IOIMP,*) MOTERR
364 : C
365 : C********** Message d'erreur standard
366 : C 21 2
367 : C Données incompatibles
368 : C
368 : CALL ERREUR(21)
369 : GOTO 9999
370 : ENDIF
371 : MLRMPI = IRETR
372 : SEGACT MLRMPI
373 : NESP1 = MLRMPI.PROG(/1)
374 : IF(NESP1 .NE. (NESP + 1))THEN
375 : C
376 : C********** Message d'erreur standard
377 : C -301 0 %m1:40
378 : C
379 : MOTERR = 'DIME(TAB1.MPIN) != NESP '
380 : WRITE(IOIMP,*) MOTERR(1:40)
381 : C
382 : C********** Message d'erreur standard
383 : C 21 2
384 : C Données incompatibles
385 : C
385 : CALL ERREUR(21)
386 : GOTO 9999
387 : ENDIF
388 : C
389 : C**** List de PINF, PHI > 0 (MLRPPI)
390 : C
391 : MTYPI = 'MOT '
392 : TYPE = ' '
392 : CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,'PPIN', LOGII,IRETI,
393 : & TYPE,IVALR,XVALR ,CHARR,LOGIR,IRETR)
394 : IF((IERR .NE. 0) .OR. (TYPE .NE. 'LISTREEL')) THEN
395 : C
396 : C********** Message d'erreur standard
397 : C -301 0 %m1:40
398 : C
399 : MOTERR = ' TAB1 . PPIN = ??? '
400 : WRITE(IOIMP,*) MOTERR
401 : C
402 : C********** Message d'erreur standard
403 : C 21 2
404 : C Données incompatibles
405 : C
405 : CALL ERREUR(21)
406 : GOTO 9999
407 : ENDIF
408 : MLRPPI = IRETR
409 : SEGACT MLRPPI
410 : NESP1 = MLRPPI.PROG(/1)
411 : IF(NESP1 .NE. (NESP + 1))THEN
412 : C
413 : C********** Message d'erreur standard
414 : C -301 0 %m1:40
415 : C
416 : MOTERR = 'DIME(TAB1.PPIN) != NESP '
417 : WRITE(IOIMP,*) MOTERR(1:40)
418 : C
419 : C********** Message d'erreur standard
420 : C 21 2
421 : C Données incompatibles
422 : C
422 : CALL ERREUR(21)
423 : GOTO 9999
424 : ENDIF
425 : C
426 : C***********************************************************************
427 : C******************** Lecture du reste *********************************
428 : C***********************************************************************
429 : C
430 : C**********************************
431 : C**** Lecture de l'objet MODELE ***
432 : C**********************************
433 : C
434 : ICOND = 1
434 : CALL QUETYP(TYPE,ICOND,IRET)
435 :
436 : IF(IRET.EQ.0.AND.TYPE.NE.'MMODEL')THEN
437 : WRITE(IOIMP,*)' On attend un objet MMODEL'
438 : RETURN
439 : ENDIF
439 : CALL LIROBJ('MMODEL',MMODEL,ICOND,IRET)
440 : IF(IERR.NE.0)GOTO 9999
440 : CALL LEKMOD(MMODEL,IDOMA,INEFMD)
441 : IF(IERR.NE.0)GOTO 9999
442 : C
443 : C**** Centre, FACE et FACEL
444 : C
444 : CALL LEKTAB(IDOMA,'CENTRE',MELEMC)
445 : IF(IERR .NE. 0) GOTO 9999
446 : C
446 : CALL LEKTAB(IDOMA,'FACE',MELEMF)
447 : IF(IERR .NE. 0) GOTO 9999
448 : C
448 : CALL LEKTAB(IDOMA,'FACEL',MELEFE)
449 : IF(IERR .NE. 0) GOTO 9999
450 : C
451 : C**** Lecture du CHPOINT contenant les surfaces des faces.
452 : C
452 : CALL LEKTAB(IDOMA,'XXSURFAC',ICHPSU)
453 : IF(IERR .NE. 0) GOTO 9999
454 : C
455 : C**** Lecture du CHPOINT contenant les diametres minimums.
456 : C
456 : CALL LEKTAB(IDOMA,'XXDIEMIN',ICHPDI)
457 : IF(IERR .NE. 0) GOTO 9999
458 : C
459 : C**** Lecture du CHPOINT contenant les volumes
460 : C
460 : CALL LEKTAB(IDOMA,'XXVOLUM',ICHPVO)
461 : IF(IERR .NE. 0) GOTO 9999
462 : C
463 : C********** Les normales aux faces
464 : C
465 : IF(IDIM .EQ. 2)THEN
466 : C Que les normales
466 : CALL LEKTAB(IDOMA,'XXNORMAF',INORM)
467 : IF(IERR .NE. 0) GOTO 9999
468 : JGN = 4
469 : JGM = 2
470 : SEGINI MLMVIT
471 : MLMVIT.MOTS(1) = 'UX '
472 : MLMVIT.MOTS(2) = 'UY '
472 : CALL QUEPO1(INORM, MELEMF, MLMVIT)
473 : SEGSUP MLMVIT
474 : IF(IERR .NE. 0) GOTO 9999
475 : ELSE
476 : C Les normales et les tangentes
477 : TYPE = ' '
477 : CALL ACMO(IDOMA,'MATROT',TYPE,INORM)
478 : IF (TYPE .NE. 'CHPOINT ') THEN
478 : CALL MATRAN(IDOMA,INORM)
479 : IF(IERR .NE. 0) GOTO 9999
480 : ENDIF
481 : JGN = 4
482 : JGM = 9
483 : SEGINI MLMVIT
484 : MLMVIT.MOTS(1) = 'UX '
485 : MLMVIT.MOTS(2) = 'UY '
486 : MLMVIT.MOTS(3) = 'UZ '
487 : MLMVIT.MOTS(4) = 'RX '
488 : MLMVIT.MOTS(5) = 'RY '
489 : MLMVIT.MOTS(6) = 'RZ '
490 : MLMVIT.MOTS(7) = 'MX '
491 : MLMVIT.MOTS(8) = 'MY '
492 : MLMVIT.MOTS(9) = 'MZ '
492 : CALL QUEPO1(INORM, MELEMF, MLMVIT)
493 : SEGSUP MLMVIT
494 : ENDIF
495 : C
496 : C********************************
497 : C**** Fin table domaine *********
498 : C********************************
499 : C
500 : C**** Lecture du CHPOINT PHI1 (level set)
501 : C
502 : TYPE='CHPOINT '
503 : ICOND = 1
503 : CALL LIROBJ(TYPE,IPHI1,ICOND,IRET)
504 : IF(IERR .NE. 0)GOTO 9999
505 : C
506 : C**** Control du CHPOINT: QUEPOI
507 : C
508 : C INDIC = 1 -> on impose le pointeur du support geometrique (ICEN)
509 : C N.B. Le CHPOINT peut changer de structure pour
510 : C avoir SPG = ICEN!!!!
511 : C INDIC = 0 -> on ne fait que verifier le support geometrique
512 : C (ICEN). Si le SPG sont differents INDIC = -4 en sortie
513 : C
514 : C NBCOMP > 0 -> numero des composantes
515 : C
516 : C MOT1(1) = ' ' obligatoire s'on connais pas les noms des composantes
517 : C
518 : INDIC = 1
519 : NBCOMP = 1
520 : MOT1(1) = 'SCAL'
520 : CALL QUEPOI(IPHI1, MELEMC, INDIC, NBCOMP, MOT1)
521 : IF(IERR .NE. 0)THEN
522 : C
523 : C******** Message d'erreur standard
524 : C -301 0 %m1:40
525 : C
526 : MOTERR = 'IPHI1 = ??? '
527 : WRITE(IOIMP,*) MOTERR(1:40)
528 : GOTO 9999
529 : ENDIF
530 : C
531 : IF (NESP .GE. 1) THEN
532 : C
533 : C******* ALPHA au centre.
534 : C
535 : ICOND = 1
536 : TYPE = 'CHPOINT '
536 : CALL LIROBJ(TYPE,IALC,1,IRET)
537 : IF (IERR.NE.0) GOTO 9999
538 : C
539 : C**** Control du CHPOINT
540 : C
540 : CALL QUEPO1(IALC, MELEMC, MLMESP)
541 : IF(IERR .NE. 0) GOTO 9999
542 : ENDIF
543 : C
544 : C**** On va lire les pointeurs des MCHAMLs
545 : C Lecture du MCHAML 'FACEL' alpha
546 : C
547 : TYPE='MCHAML '
547 : CALL LIROBJ(TYPE,IPHIF,1,IRET)
548 : IF(IERR.NE.0) GOTO 9999
549 : C Lecture du MCHAML 'FACEL' densité
550 : C
551 : TYPE='MCHAML '
551 : CALL LIROBJ(TYPE,IROF1,1,IRET)
552 : IF(IERR.NE.0) GOTO 9999
553 : C
554 : C**** Lecture du MCHAML 'FACEL' vitesse
555 : C
556 : TYPE='MCHAML '
556 : CALL LIROBJ(TYPE,IVITF1,1,IRET)
557 : IF(IERR .NE. 0) GOTO 9999
558 : C
559 : C**** Lecture du MCHAML 'FACEL' contenant la pression
560 : C
561 : TYPE='MCHAML '
561 : CALL LIROBJ(TYPE,IPF1,1,IRET)
562 : IF(IERR .NE. 0) GOTO 9999
563 : C
564 : IF (NESP .GE. 1) THEN
565 : C
566 : C******** Lecture du MCHAML 'FACEL' contenant les fractiones massiques
567 : C ET ALPHA
568 : C
569 : TYPE='MCHAML '
569 : CALL LIROBJ(TYPE,IFRMAF,1,IRET)
570 : IF(IERR .NE. 0) GOTO 9999
571 : C
572 : TYPE='MCHAML '
572 : CALL LIROBJ(TYPE,IFRALF,1,IRET)
573 : IF(IERR .NE. 0) GOTO 9999
574 : C
575 : ELSE
576 : C
577 : IFRMAF = 0
578 : IFRALF = 0
579 : C
580 : ENDIF
581 : C
582 : C**** NINC = nombre d'inconnues
583 : C
584 : NINC=(IDIM+3)+(2*NESP)
585 : C
586 : TYPE='LISTMOTS'
586 : CALL LIROBJ(TYPE,ILIINC,1,IRET)
587 : IF(IERR .NE. 0) GOTO 9999
588 : MLMOTS = ILIINC
589 : SEGACT MLMOTS
590 : NC = MLMOTS.MOTS(/2)
591 : SEGDES MLMOTS
592 : IF(NC .NE. NINC)THEN
593 : MOTERR(1:40) = 'LISTINCO = ???'
594 : WRITE(IOIMP,*) MOTERR
595 : C
596 : C******* Message d'erreur standard
597 : C 21 2
598 : C Données incompatibles
599 : C
599 : CALL ERREUR(21)
600 : GOTO 9999
601 : ENDIF
602 : C
603 : C**** Boundary condition
604 : C
605 : IRET=0
606 : TYPE='MAILLAGE'
606 : CALL LIROBJ(TYPE,IFLIM,0,IRET)
607 : IF(IERR.NE.0)GOTO 9999
608 : IF(IRET .EQ. 0)THEN
609 : MELLIM = 0
610 : ELSE
611 : MELEME=IFLIM
612 : SEGACT MELEME
613 : ITOTO=MELEME.NUM(/2)
614 : IF(ITOTO .EQ. 0)THEN
615 : MELLIM = 0
616 : ELSE
617 : MELLIM = IFLIM
618 : ENDIF
619 : SEGDES MELEME
620 : ENDIF
621 : C
622 : C**** Conservative or non-conservative approach
623 : C
623 : CALL LIRLOG(LOGCON , ICOND , IRET)
624 : IF (IERR.NE.0) GOTO 9999
625 : C
626 : C**** Minimum pressure for vacuum
627 : C
627 : CALL LIRREE(PMIN, ICOND , IRET)
628 : IF (IERR.NE.0) GOTO 9999
629 : C
630 : C
631 : C write(*,*) 'Son qui dopo la lettura degli inputs'
632 : C
633 : C**** Creation du residu
634 : C
635 : TYPE = 'CHPOINT '
635 : CALL KRCHP1(TYPE, MELEMC, ICHRES, MLMOTS)
636 : C
637 : C**** Calcul des flux et du pas du temps.
638 : C
639 : IF( IDIM .EQ. 2)THEN
639 : CALL KGFM12(LOGCON,
640 : & NESP,
641 : & INDMET,
642 : & MLRMGA, MLRMPI, MLRPGA, MLRPPI,
643 : & PMIN,
644 : & IPHI1, IALC,
645 : & IPHIF,IROF1,IVITF1,IPF1,
646 : & IFRMAF, IFRALF,
647 : & ICHPSU,ICHPDI,ICHPVO,
648 : & MELEMC,MELEMF,MELEFE,MELLIM,
649 : & ICHRES,
650 : & DT,
651 : & LOGNC,LOGAN,MESERR)
652 : C ELSE
652 : C CALL KONFL4(LOGME,LOGSCA,INDMET,NORDP1,
653 : C & IROF,IVITF,IPF,IFRMAF,ISCAF,PROPHY,
654 : C & ICHPSU,ICHPDI,
655 : C & MELEMC,MELEMF,MELEFE,MELLIM,
656 : C & ICHRES,
657 : C & DT,
658 : C & LOGNC,LOGAN,MESERR)
659 : ENDIF
660 : C
661 : IF(LOGAN)THEN
662 : C
663 : C******* Anomalie detectée
664 : C
665 : C
666 : C******* Message d'erreur standard
667 : C -301 0
668 : C %m1:40
669 : C
670 : MOTERR(1:40) = MESERR(1:40)
671 : WRITE(IOIMP,*) MOTERR(1:40)
672 : C
673 : C******* Message d'erreur standard
674 : C 5 3
675 : C Erreur anormale.contactez votre support
676 : C
676 : CALL ERREUR(5)
677 : GOTO 9999
678 : ENDIF
679 : IF(LOGNC)THEN
680 : C
681 : C******* Message d'erreur standard
682 : C -301 0
683 : C %m1:40
684 : C
685 : MOTERR(1:40) = MESERR(1:40)
686 : WRITE(IOIMP,*) MOTERR(1:40)
687 : C
688 : C******* Message d'erreur standard
689 : C 460 2
690 : C Pas de convergence dans les itérations internes
691 : C
691 : CALL ERREUR(460)
692 : GOTO 9999
693 : ENDIF
694 : C
695 : C**** Ecriture des resultats
696 : C
696 : CALL ECRREE(DT)
697 : TYPE = 'CHPOINT '
697 : IF(ICHRES .NE. 0) CALL ECROBJ(TYPE,ICHRES)
698 : C
699 : 9999 CONTINUE
700 : RETURN
701 : END
702 :
703 :
704 :
705 :
706 :
707 :
708 :
709 :
710 :
711 :
712 :
713 :
714 :
715 :
716 :
717 :
© Cast3M 2003 - All rights reserved.
Disclaimer