1 : C KONV13 SOURCE BECC 11/06/08 21:15:41 7000
2 : SUBROUTINE KONV13
3 : C************************************************************************
4 : C
5 : C PROJET : CASTEM 2000
6 : C
7 : C NOM : KONV13
8 : C
9 : C DESCRIPTION : Subroutine appellée par KONV1
10 : C
11 : C Modelisation 2D/3D des equations d'Euler.
12 : C Discrete Equation Method for combustion.
13 : C
14 : C Calcul du residu / jacobien / 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) : KDEM12 (2D, gaz "thermally perfect", DEM)
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 gaz parfait mono-constituent. Methode DEM.
30 : C Inconnues: alpha, densité, quantité de mouvement, énergie totale par
31 : C unité de volume (variables conservatives)
32 : C
33 : C RCHPO1 RFLOT1 SURF1 = 'KONV' 'VF' 'DEM' MOT1 MOT2 MOD1 TABPG
34 : C LMOT1 MCHAA1 MCHAA2 ICHPK0 GRALP1 EPS
35 : C MAILLIM ;
36 : C ENTREES
37 : C
38 : C
39 : C MOT1 : objet de type MOT
40 : C Il vaut 'RESI' si on veut calculer le résidu
41 : C
42 : C MOT2 : objet de type MOT
43 : C Il indique la méthode de décentrement:
44 : C 'SS = solveur choc-choc
45 : C
46 : C MOD1 : objet modele de type Navier_Stokes
47 : C
48 : C TABG : objet de type TABLE
49 : C il contient les proprietes du gaz:
50 : C
51 : C LMOT1 : objet de type LISTMOTS
52 : C Noms de composantes du résultat (RCHPO1)
53 : C Il contient dans l'ordre suivant: le noms de alpha,
54 : C de la densité,
55 : C de la vitesse, de l'énergie totale par unité de volume
56 : C
57 : C MCHAA1 : MCHAML contenant la fraction volumique alpha de la phase 1,
58 : C qui a comme SPG (support géométrique) l'indice 'FACEL' de la
59 : C table associée à MOD1 (une composante, 'SCAL')
60 : C
61 : C MCHAA2 : MCHAML contenant la fraction volumique alpha de la phase 2,
62 : C même SPG que MCHAA1, une composante, 'SCAL'
63 : C
64 : C MCHAR1 : MCHAML contenant la masse volumique de la phase 1,
65 : C même SPG que MCHAA1, une composante, 'SCAL'
66 : C
67 : C MCHAR2 : MCHAML contenant la masse volumique de la phase 2,
68 : C même SPG que MCHAA1, une composante, 'SCAL'
69 : C
70 : C MCHAV1 : MCHAML contenant la vitesse de la phase 1 et les cosinus
71 : C directeurs du repère locale (n,t) dans le repère
72 : C global (x,y), même SPG que MCHAA1,
73 : C (dans le cas 2D 6 composantes:
74 : C * 'UN' = vitesse normale (SPG =('DOMA' MOD1 'FACEL'))
75 : C * 'UT' = vitesse tangentielle (SPG =('DOMA' MOD1 'FACEL'))
76 : C * 'NX' = n.x (SPG = 'FACE')
77 : C * 'NY' = n.y (SPG = 'FACE')
78 : C * 'TX' = t.x (SPG = 'FACE')
79 : C * 'TY' = t.y (SPG = 'FACE')).
80 : C
81 : C MCHAV2 : MCHAML contenant la vitesse de la phase 1 et les cosinus
82 : C directeurs du repère locale (n,t) dans le repère
83 : C global (x,y), même SPG que MCHAA1,
84 : C (dans le cas 2D 6 composantes:
85 : C * 'UN' = vitesse normale (SPG =('DOMA' MOD1 'FACEL'))
86 : C * 'UT' = vitesse tangentielle (SPG =('DOMA' MOD1 'FACEL'))
87 : C * 'NX' = n.x (SPG = 'FACE')
88 : C * 'NY' = n.y (SPG = 'FACE')
89 : C * 'TX' = t.x (SPG = 'FACE')
90 : C * 'TY' = t.y (SPG = 'FACE')).
91 : C
92 : C MCHAP1 : MCHAML (SPG =('DOMA' MOD1 'FACEL')) contenant la pression de
93 : C la phase 1 (une seule composante, 'SCAL').
94 : C
95 : C MCHAP2 : MCHAML (SPG =('DOMA' MOD1 'FACEL')) contenant la pression de
96 : C la phase 2 (une seule composante, 'SCAL').
97 : C
98 : C K0 : CHPOINT, fundamental flame speed
99 : C
100 : C GRALP1 : CHPOINT, grad(alp1)/|grad(alp1)|
101 : C
102 : C EPSILON : FLOTTANT t.q. a < EPSILON => a = 0
103 : C
104 : C MAILLIM : MAILLAGE -- describes the mesh where the flux is not
105 : C determined; it will be found by using
106 : C the subroutins for the Boundary Conditions
107 : C
108 : C SORTIES
109 : C
110 : C RCHPO1 : objet de type CHPOINT (composantes = LMOT1)
111 : C Residu si MOT2 = 'RESI' (SPG =('DOMA' MOD1 'CENTRE'))
112 : C
113 : C RFLOT1 : objet de type FLOTTANT
114 : C Il est le temps caracteristique associé à l'onde la plus
115 : C rapide.
116 : C
117 : C SURF1 : objet de type FLOTTANT
118 : C Surface de combustion
119 : C
120 : C Remarque
121 : C --------
122 : C
123 : C RCHPO1 est égal à:
124 : C * la derivé temporelle des inconnues si l'option 'RESI' est utilisée
125 : C
126 : C
127 : C***********************************************************************
128 : C
129 : C************************************************************************
130 : C
131 : C HISTORIQUE (Anomalies et modifications éventuelles)
132 : C
133 : C 07/12/2009 - Created
134 : C 21/12/2010 - Estension au 3D
135 : C
136 : C************************************************************************
137 : C
138 : IMPLICIT INTEGER(I-N)
139 : C
140 : -INC CCOPTIO
141 : -INC SMLMOTS
142 : POINTEUR MLMVIT.MLMOTS, MLMOEU.MLMOTS, MLMOSC.MLMOTS,
143 : $ MLMESP.MLMOTS
144 : -INC SMLREEL
145 : POINTEUR MLRMFR.MLREEL, MLRCHE.MLREEL
146 : -INC SMELEME
147 : C
148 : INTEGER IDOMA, MELEMC, MELEMF, MELEFE, ICHPSU, ICHPDI , ICHPVO
149 : & , INORM, MELLIM, IFLIM
150 : & , NBMET, INDMET, IRET, INDK0
151 : & , IPGAS, NORD, NORDP1, NESP, IESP
152 : & , JGM, JGN
153 : & , I1, I2
154 : & , INDIC, NBCOMP
155 : & , IALP1, IALP2
156 : & , IALF1, IROF1, IVITF1, IPF1
157 : & , IALF2, IROF2, IVITF2, IPF2
158 : & , IGRALP
159 : & , ICHPK0
160 : & , NINC, ILIINC, NC, ICELL
161 : & , ICHRES, INEFMD, ICOND, MMODEL
162 : & , ITOTO, NORD1, NESP1
163 : & , N1, N2
164 : & , IUINF1, IUINF2
165 : REAL*8 RUNIV, TMAX, EPS, K0
166 : C
167 : C**** Variables en ACCTAB
168 : C
169 : INTEGER IVALI, IRETI,IVALR, IRETR
170 : REAL*8 XVALI, XVALR
171 : LOGICAL LOGII, LOGIR
172 : CHARACTER*(8) MTYPI, MTYPR, CHARR
173 : C
174 : C**** Segment des proprietes du gaz
175 : C
176 : SEGMENT PROPHY
177 : REAL*8 XTAB(N1,N2)
178 : C REAL*8 ACV(NORDP1,NESP+1), W(NESP+1), H0K(NESP+1)
179 : C & ,ACVTOG(NORDP1), ACVTOD(NORDP1)
180 : ENDSEGMENT
181 : C
182 : PARAMETER (NBMET=3)
183 : REAL*8 DT, SURFL
184 : CHARACTER*8 LMETO(NBMET), TYPE
185 : CHARACTER*4 LFLUX(1), MOT1(1), LK0(2)
186 : CHARACTER*(40) MESERR
187 : LOGICAL LOGNC, LOGAN, LOGRES
188 : C
189 : DATA LMETO/'VLH ','SS ','AUSMPUP '/
190 : DATA LFLUX/'RESI'/
191 : DATA LK0/'CONS','VARI'/
192 : C
193 : C**** Initialisation des variables pour la gestion des erreurs.
194 : C
195 : LOGNC = .FALSE.
196 : LOGAN = .FALSE.
197 : MESERR = ' '
198 : C
199 : C******* Flux ou residu???
200 : C
200 : CALL LIRMOT(LFLUX,1,ICELL,1)
201 : IF(IERR .NE. 0)GOTO 9999
202 : IF(ICELL .NE. 1)THEN
203 : C LOGRES = .TRUE.
204 : C ELSE
205 : C
206 : C******** Message d'erreur standard
207 : C 251 2
208 : C Tentative d'utilisation d'une option non implémentée
209 : C
209 : CALL ERREUR(251)
210 : ENDIF
211 : C
212 : C**** Metode utilisée
213 : C
213 : CALL LIRMOT(LMETO,NBMET,INDMET,1)
214 : IF(IERR .NE. 0)GOTO 9999
215 : IF(INDMET .EQ. 0)THEN
216 : C
217 : C******** Message d'erreur standard
218 : C 251 2
219 : C Tentative d'utilisation d'une option non implémentée
220 : C
220 : CALL ERREUR(251)
221 : ENDIF
222 : C
223 : C**** KO constant ou variable ???
224 : C
224 : CALL LIRMOT(LK0,2,INDK0,1)
225 : IF(IERR .NE. 0)GOTO 9999
226 : IF(INDK0 .EQ. 0)THEN
227 : C
228 : C******** Message d'erreur standard
229 : C 251 2
230 : C Tentative d'utilisation d'une option non implémentée
231 : C
231 : CALL ERREUR(251)
232 : ENDIF
233 : C
234 : C**********************************
235 : C**** Lecture de l'objet MODELE ***
236 : C**********************************
237 : C
238 : ICOND = 1
238 : CALL QUETYP(TYPE,ICOND,IRET)
239 :
240 : IF(IRET.EQ.0.AND.TYPE.NE.'MMODEL')THEN
241 : WRITE(IOIMP,*)' On attend un objet MMODEL'
242 : RETURN
243 : ENDIF
243 : CALL LIROBJ('MMODEL',MMODEL,ICOND,IRET)
244 : IF(IERR.NE.0)GOTO 9999
244 : CALL LEKMOD(MMODEL,IDOMA,INEFMD)
245 : IF(IERR.NE.0)GOTO 9999
246 : C
247 : C**** Centre, FACE et FACEL
248 : C
248 : CALL LEKTAB(IDOMA,'CENTRE',MELEMC)
249 : IF(IERR .NE. 0) GOTO 9999
250 : C
250 : CALL LEKTAB(IDOMA,'FACE',MELEMF)
251 : IF(IERR .NE. 0) GOTO 9999
252 : C
252 : CALL LEKTAB(IDOMA,'FACEL',MELEFE)
253 : IF(IERR .NE. 0) GOTO 9999
254 : C
255 : C**** Lecture du CHPOINT contenant les surfaces des faces.
256 : C
256 : CALL LEKTAB(IDOMA,'XXSURFAC',ICHPSU)
257 : IF(IERR .NE. 0) GOTO 9999
258 : C
259 : C**** Lecture du CHPOINT contenant les diametres minimums.
260 : C
260 : CALL LEKTAB(IDOMA,'XXDIEMIN',ICHPDI)
261 : IF(IERR .NE. 0) GOTO 9999
262 : C
263 : C**** Lecture du CHPOINT contenant les volumes
264 : C
264 : CALL LEKTAB(IDOMA,'XXVOLUM',ICHPVO)
265 : IF(IERR .NE. 0) GOTO 9999
266 : C
267 : C********** Les normales aux faces
268 : C
269 : IF(IDIM .EQ. 2)THEN
270 : C Que les normales
270 : CALL LEKTAB(IDOMA,'XXNORMAF',INORM)
271 : IF(IERR .NE. 0) GOTO 9999
272 : JGN = 4
273 : JGM = 2
274 : SEGINI MLMVIT
275 : MLMVIT.MOTS(1) = 'UX '
276 : MLMVIT.MOTS(2) = 'UY '
276 : CALL QUEPO1(INORM, MELEMF, MLMVIT)
277 : SEGSUP MLMVIT
278 : IF(IERR .NE. 0) GOTO 9999
279 : ELSE
280 : C Les normales et les tangentes
281 : TYPE = ' '
281 : CALL ACMO(IDOMA,'MATROT',TYPE,INORM)
282 : IF (TYPE .NE. 'CHPOINT ') THEN
282 : CALL MATRAN(IDOMA,INORM)
283 : IF(IERR .NE. 0) GOTO 9999
284 : ENDIF
285 : JGN = 4
286 : JGM = 9
287 : SEGINI MLMVIT
288 : MLMVIT.MOTS(1) = 'UX '
289 : MLMVIT.MOTS(2) = 'UY '
290 : MLMVIT.MOTS(3) = 'UZ '
291 : MLMVIT.MOTS(4) = 'RX '
292 : MLMVIT.MOTS(5) = 'RY '
293 : MLMVIT.MOTS(6) = 'RZ '
294 : MLMVIT.MOTS(7) = 'MX '
295 : MLMVIT.MOTS(8) = 'MY '
296 : MLMVIT.MOTS(9) = 'MZ '
296 : CALL QUEPO1(INORM, MELEMF, MLMVIT)
297 : SEGSUP MLMVIT
298 : ENDIF
299 : C
300 : C********************************
301 : C**** Fin table domaine *********
302 : C********************************
303 : C********************************
304 : C**** La table IPGAZ *******
305 : C********************************
306 : C
307 : C write(*,*) 'Son qui prima di ipgaz'
308 : C
309 : C**** Lecture de la table des proprietes du gaz
310 : C
311 : ICOND = 1
311 : CALL QUETYP(TYPE,ICOND,IRET)
312 : IF(IERR .NE. 0)GOTO 9999
313 : IF(TYPE .NE. 'TABLE ')THEN
314 : C
315 : C******* Message d'erreur standard
316 : C 37 2
317 : C On ne trouve pas d'objet de type %m1:8
318 : C
319 : MOTERR(1:8) = 'TABLE '
319 : CALL ERREUR(37)
320 : GOTO 9999
321 : ELSE
322 : ICOND = 1
322 : CALL LIROBJ(TYPE,IPGAS,ICOND,IRET)
323 : IF(IERR .NE. 0)GOTO 9999
324 : ENDIF
325 : C
326 : C**** Ordre des polynoms pour les cv_i
327 : C
328 : MTYPI = 'MOT '
329 : MTYPR = ' '
329 : CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,'NORD',LOGII,IRETI,
330 : & MTYPR,NORD,XVALR,CHARR,LOGIR,IESP)
331 : IF(MTYPR .NE. 'ENTIER ')THEN
332 : C
333 : C******* Message d'erreur standard
334 : C -301 0 %m1:40
335 : C
336 : MOTERR(1:40) = 'TAB1 . NORD = ??? '
337 : WRITE(IOIMP,*) MOTERR(1:40)
338 : C
339 : C******* Message d'erreur standard
340 : C 21 2
341 : C Données incompatibles
342 : C
342 : CALL ERREUR(21)
343 : GOTO 9999
344 : ENDIF
345 : NORDP1 = NORD + 1
346 : C
347 : C**** 'TMAX'
348 : C
349 : MTYPI = 'MOT '
350 : MTYPR = ' '
350 : CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,'TMAX',LOGII,IRETI,
351 : & MTYPR,IVALR,XVALR,CHARR,LOGIR,IESP)
352 : IF(MTYPR .NE. 'FLOTTANT')THEN
353 : C
354 : C******* Message d'erreur standard
355 : C -301 0 %m1:40
356 : C
357 : MOTERR(1:40) = 'TAB1 . TMAX = ??? '
358 : WRITE(IOIMP,*) MOTERR(1:40)
359 : C
360 : C******* Message d'erreur standard
361 : C 21 2
362 : C Données incompatibles
363 : C
363 : CALL ERREUR(21)
364 : GOTO 9999
365 : ENDIF
366 : TMAX = XVALR
367 : C
368 : C**** 'RUNIV'
369 : C
370 : MTYPI = 'MOT '
371 : MTYPR = ' '
371 : CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,'RUNIV',LOGII,IRETI,
372 : & MTYPR,IVALR,XVALR,CHARR,LOGIR,IESP)
373 : IF(MTYPR .NE. 'FLOTTANT')THEN
374 : C
375 : C******* Message d'erreur standard
376 : C -301 0 %m1:40
377 : C
378 : MOTERR(1:40) = 'TAB1 . RUNIV = ??? '
379 : WRITE(IOIMP,*) MOTERR(1:40)
380 : C
381 : C******* Message d'erreur standard
382 : C 21 2
383 : C Données incompatibles
384 : C
384 : CALL ERREUR(21)
385 : GOTO 9999
386 : ENDIF
387 : RUNIV = XVALR
388 : C
389 : C**** Les especes
390 : C
391 : MTYPR = ' '
391 : CALL ACMO(IPGAS,'SPECIES',MTYPR,MLMESP)
392 : IF(MTYPR .NE. 'LISTMOTS')THEN
393 : C
394 : C******* Message d'erreur standard
395 : C -301 0 %m1:40
396 : C
397 : MOTERR(1:40) = 'TAB1 . SPECIES = ??? '
398 : WRITE(IOIMP,*) MOTERR(1:40)
399 : C
400 : C******* Message d'erreur standard
401 : C 21 2
402 : C Données incompatibles
403 : C
403 : CALL ERREUR(21)
404 : GOTO 9999
405 : ELSE
406 : SEGACT MLMESP
407 : NESP = MLMESP.MOTS(/2)
408 : SEGDES MLMESP
409 : ENDIF
410 : C
411 : C**** 'MASSFRA'
412 : C
413 : MTYPR = ' '
413 : CALL ACMO(IPGAS,'MASSFRA',MTYPR,MLRMFR)
414 : IF(MTYPR .NE. 'LISTREEL')THEN
415 : C
416 : C******* Message d'erreur standard
417 : C -301 0 %m1:40
418 : C
419 : MOTERR(1:40) = 'TAB1 . MASSFRA = ??? '
420 : WRITE(IOIMP,*) MOTERR(1:40)
421 : C
422 : C******* Message d'erreur standard
423 : C 21 2
424 : C Données incompatibles
425 : C
425 : CALL ERREUR(21)
426 : GOTO 9999
427 : ELSE
428 : SEGACT MLRMFR
429 : NESP1 = MLRMFR.PROG(/1)
430 : IF (NESP1 .NE. NESP) THEN
431 : MOTERR(1:40) = 'TAB1 . MASSFRA = ??? '
432 : WRITE(IOIMP,*) MOTERR(1:40)
433 : MOTERR(1:40) = 'TAB1 . SPECIES = ??? '
434 : WRITE(IOIMP,*) MOTERR(1:40)
435 : C
436 : C******* Message d'erreur standard
437 : C 21 2
438 : C Données incompatibles
439 : C
439 : CALL ERREUR(21)
440 : GOTO 9999
441 : ENDIF
442 : SEGDES MLRMFR
443 : ENDIF
444 : C
445 : C**** 'CHEMCOEF'
446 : C
447 : MTYPR = ' '
447 : CALL ACMO(IPGAS,'CHEMCOEF',MTYPR,MLRCHE)
448 : IF(MTYPR .NE. 'LISTREEL')THEN
449 : C
450 : C******* Message d'erreur standard
451 : C -301 0 %m1:40
452 : C
453 : write(IOIMP,*) MTYPR
454 : MOTERR(1:40) = 'TAB1 . CHEMCOEF = ??? '
455 : WRITE(IOIMP,*) MOTERR(1:40)
456 : C
457 : C******* Message d'erreur standard
458 : C 21 2
459 : C Données incompatibles
460 : C
460 : CALL ERREUR(21)
461 : GOTO 9999
462 : ELSE
463 : SEGACT MLRCHE
464 : NESP1 = MLRCHE.PROG(/1)
465 : IF (NESP1 .NE. NESP) THEN
466 : MOTERR(1:40) = 'TAB1 . CHEMCOEF = ??? '
467 : WRITE(IOIMP,*) MOTERR(1:40)
468 : MOTERR(1:40) = 'TAB1 . SPECIES = ??? '
469 : WRITE(IOIMP,*) MOTERR(1:40)
470 : C
471 : C******* Message d'erreur standard
472 : C 21 2
473 : C Données incompatibles
474 : C
474 : CALL ERREUR(21)
475 : GOTO 9999
476 : ENDIF
477 : SEGDES MLRCHE
478 : ENDIF
479 : C
480 : C**** On rempli les segment PROPHY
481 : C Ordre: IPGAS . 'SPECIES'
482 : C
483 : N1 = NORDP1 + 2
484 : N2 = NESP
485 : SEGINI PROPHY
486 : SEGACT MLMESP
487 : C
488 : C**** N.B. MOT1 est un CHARACTER*(4)
489 : C
490 : DO I1 = 1, NESP
491 : MOT1(1) = MLMESP.MOTS(I1)
492 : C
492 : C******* CALL ACMF(...) ne marche pas parce que on a
493 : C des blanches dans nos composantes
494 : C
495 : MTYPI = 'MOT '
496 : MTYPR = ' '
496 : CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,MOT1(1), LOGII,IRETI,
497 : & MTYPR,IVALR,XVALR,CHARR,LOGIR,IESP)
498 : C
499 : C******* En IESP a la table IPGAS.MOT1(1)
500 : C
501 : IF((IERR .NE. 0) .OR. (MTYPR .NE. 'TABLE ')) THEN
502 :
503 : C
504 : C********** Message d'erreur standard
505 : C -301 0 %m1:40
506 : C
507 : MOTERR = ' '
508 : MOTERR(1:7) = 'TAB1 . '
509 : MOTERR(8:11) = MOT1(1)
510 : MOTERR(13:17) = '= ???'
511 : WRITE(IOIMP,*) MOTERR(1:40)
512 : C
513 : C********** Message d'erreur standard
514 : C 21 2
515 : C Données incompatibles
516 : C
516 : CALL ERREUR(21)
517 : GOTO 9999
518 : ENDIF
519 : C
520 : C******* W
521 : C
522 : MTYPI = 'MOT '
523 : MTYPR = ' '
523 : CALL ACCTAB(IESP,MTYPI,IVALI,XVALI, 'W' , LOGII,IRETI,
524 : & MTYPR,IVALR, XVALR ,CHARR,LOGIR,IRETR)
525 : IF((IERR .NE. 0) .OR. (MTYPR .NE. 'FLOTTANT')) THEN
526 : C
527 : C********** Message d'erreur standard
528 : C -301 0 %m1:40
529 : C
530 : MOTERR = ' '
531 : MOTERR(1:7) = 'TAB1 . '
532 : MOTERR(8:11) = MOT1(1)
533 : MOTERR(13:23) = ' . W = ??? '
534 : WRITE(IOIMP,*) MOTERR(1:40)
535 : C
536 : C********** Message d'erreur standard
537 : C 21 2
538 : C Données incompatibles
539 : C
539 : CALL ERREUR(21)
540 : GOTO 9999
541 : ENDIF
542 : C PROPHY.W(I1)=XVALR
543 : PROPHY.XTAB(NORDP1+1,I1)=XVALR
544 : C
545 : C******* H0K
546 : C
547 : MTYPI = 'MOT '
548 : MTYPR = ' '
548 : CALL ACCTAB(IESP,MTYPI,IVALI,XVALI, 'H0K' , LOGII,IRETI,
549 : & MTYPR,IVALR, XVALR ,CHARR,LOGIR,IRETR)
550 : IF((IERR .NE. 0) .OR. (MTYPR .NE. 'FLOTTANT')) THEN
551 :
552 : C
553 : C********** Message d'erreur standard
554 : C -301 0 %m1:40
555 : C
556 : MOTERR = ' '
557 : MOTERR(1:7) = 'TAB1 . '
558 : MOTERR(8:11) = MOT1(1)
559 : MOTERR(13:25) = ' . H0K = ??? '
560 : WRITE(IOIMP,*) MOTERR(1:40)
561 : C
562 : C********** Message d'erreur standard
563 : C 21 2
564 : C Données incompatibles
565 : C
565 : CALL ERREUR(21)
566 : GOTO 9999
567 : ENDIF
568 : C PROPHY.H0K(I1)=XVALR
569 : PROPHY.XTAB(NORDP1+2,I1)=XVALR
570 : C
571 : C******* A
572 : C
573 : MTYPI = 'MOT '
574 : MTYPR = ' '
574 : CALL ACCTAB(IESP,MTYPI,IVALI,XVALI, 'A' , LOGII,IRETI,
575 : & MTYPR,IVALR, XVALR ,CHARR,LOGIR,IRETR)
576 : IF((IERR .NE. 0) .OR. (MTYPR .NE. 'LISTREEL')) THEN
577 :
578 : C
579 : C********** Message d'erreur standard
580 : C -301 0 %m1:40
581 : C
582 : MOTERR = ' '
583 : MOTERR(1:7) = 'TAB1 . '
584 : MOTERR(8:11) = MOT1(1)
585 : MOTERR(13:23) = ' . A = ??? '
586 : WRITE(IOIMP,*) MOTERR(1:40)
587 : C
588 : C********** Message d'erreur standard
589 : C 21 2
590 : C Données incompatibles
591 : C
591 : CALL ERREUR(21)
592 : GOTO 9999
593 : ENDIF
594 : MLREEL = IRETR
595 : SEGACT MLREEL
596 : NORD1 = MLREEL.PROG(/1)
597 : IF(NORD1 .NE. NORDP1)THEN
598 : C
599 : C********** Message d'erreur standard
600 : C -301 0 %m1:40
601 : C
602 : MOTERR = ' '
603 : MOTERR(1:10) = 'DIME(TAB1.'
604 : MOTERR(11:14) = MOT1(1)
605 : MOTERR(15:37) = '.A) != (TAB1.NORD) + 1'
606 : WRITE(IOIMP,*) MOTERR(1:40)
607 : C
608 : C********** Message d'erreur standard
609 : C 21 2
610 : C Données incompatibles
611 : C
611 : CALL ERREUR(21)
612 : GOTO 9999
613 : ENDIF
614 :
615 : C
616 : C******* Dans le calcul, c'est plus utile ACV dans la forme
617 : C ACV(exponente,espece)
618 : C
619 : DO I2 = 1, NORDP1
620 : C PROPHY.ACV(I2,I1)= MLREEL.PROG(I2)
621 : PROPHY.XTAB(I2,I1) = MLREEL.PROG(I2)
622 : ENDDO
623 : SEGDES MLREEL
624 : ENDDO
625 : SEGDES MLMESP
626 : C
627 : C write(*,*) 'Son qui dopo ipgaz'
628 : C
629 : C**** La table IPGAZ donc a ete controllee et PROPHY est rempli
630 : C
631 : C
632 : C**** Lecture du CHPOINT ALPHA1
633 : C
634 : TYPE='CHPOINT '
635 : ICOND = 1
635 : CALL LIROBJ(TYPE,IALP1,ICOND,IRET)
636 : IF(IERR .NE. 0)GOTO 9999
637 : C
638 : C**** Control du CHPOINT: QUEPOI
639 : C
640 : C INDIC = 1 -> on impose le pointeur du support geometrique (ICEN)
641 : C N.B. Le CHPOINT peut changer de structure pour
642 : C avoir SPG = ICEN!!!!
643 : C INDIC = 0 -> on ne fait que verifier le support geometrique
644 : C (ICEN). Si le SPG sont differents INDIC = -4 en sortie
645 : C
646 : C NBCOMP > 0 -> numero des composantes
647 : C
648 : C MOT1(1) = ' ' obligatoire s'on connais pas les noms des composantes
649 : C
650 : INDIC = 1
651 : NBCOMP = 1
652 : MOT1(1) = 'SCAL'
652 : CALL QUEPOI(IALP1, MELEMC, INDIC, NBCOMP, MOT1)
653 : IF(IERR .NE. 0)THEN
654 : C
655 : C******** Message d'erreur standard
656 : C -301 0 %m1:40
657 : C
658 : MOTERR = 'IALP1 = ??? '
659 : WRITE(IOIMP,*) MOTERR(1:40)
660 : GOTO 9999
661 : ENDIF
662 : C
663 : C**** Lecture du CHPOINT ALPHA2
664 : C
665 : TYPE='CHPOINT '
666 : ICOND = 1
666 : CALL LIROBJ(TYPE,IALP2,ICOND,IRET)
667 : C
668 : C**** Control du CHPOINT: QUEPOI
669 : C
670 : INDIC = 1
671 : NBCOMP = 1
672 : MOT1(1) = 'SCAL'
672 : CALL QUEPOI(IALP2, MELEMC, INDIC, NBCOMP, MOT1)
673 : IF(IERR .NE. 0)THEN
674 : C
675 : C******** Message d'erreur standard
676 : C -301 0 %m1:40
677 : C
678 : MOTERR = 'IALP2 = ??? '
679 : WRITE(IOIMP,*) MOTERR(1:40)
680 : GOTO 9999
681 : ENDIF
682 : C
683 : C**** On va lire les pointeurs des MCHAMLs
684 : C Lecture du MCHAML 'FACEL' alpha
685 : C
686 : TYPE='MCHAML '
686 : CALL LIROBJ(TYPE,IALF1,1,IRET)
687 : IF(IERR.NE.0) GOTO 9999
687 : CALL LIROBJ(TYPE,IALF2,1,IRET)
688 : IF(IERR.NE.0) GOTO 9999
689 : C Lecture du MCHAML 'FACEL' densité
690 : C
691 : TYPE='MCHAML '
691 : CALL LIROBJ(TYPE,IROF1,1,IRET)
692 : IF(IERR.NE.0) GOTO 9999
692 : CALL LIROBJ(TYPE,IROF2,1,IRET)
693 : IF(IERR.NE.0) GOTO 9999
694 : C
695 : C**** Lecture du MCHAML 'FACEL' vitesse
696 : C
697 : TYPE='MCHAML '
697 : CALL LIROBJ(TYPE,IVITF1,1,IRET)
698 : IF(IERR .NE. 0) GOTO 9999
698 : CALL LIROBJ(TYPE,IVITF2,1,IRET)
699 : IF(IERR .NE. 0) GOTO 9999
700 : C
701 : C**** Lecture du MCHAML 'FACEL' contenant la pression
702 : C
703 : TYPE='MCHAML '
703 : CALL LIROBJ(TYPE,IPF1,1,IRET)
704 : IF(IERR .NE. 0) GOTO 9999
704 : CALL LIROBJ(TYPE,IPF2,1,IRET)
705 : IF(IERR .NE. 0) GOTO 9999
706 : C
707 : C**** Lecture du CHAMPOINT contenant grad(alpha)/|grad(alpha)|
708 : C
709 : TYPE='CHPOINT '
710 : ICOND = 1
710 : CALL LIROBJ(TYPE,IGRALP,ICOND,IRET)
711 : IF(IERR .NE. 0)GOTO 9999
712 : C
713 : C**** Control du CHPOINT
714 : C
715 : JGN = 4
716 : JGM = IDIM
717 : SEGINI MLMOTS
718 : MLMOTS.MOTS(1) = 'P1DX'
719 : MLMOTS.MOTS(2) = 'P1DY'
720 : IF(IDIM .EQ. 3) MLMOTS.MOTS(3) = 'P1DZ'
721 : C
722 : C**** On controlle l'ordre de composantes de IAGN1
723 : C
723 : CALL QUEPO1(IGRALP, MELEMF, MLMOTS)
724 : IF(IERR .NE. 0)THEN
725 : C
726 : C******** Message d'erreur standard
727 : C -301 0 %m1:40
728 : C
729 : MOTERR = 'GRAALP = ??? '
730 : WRITE(IOIMP,*) MOTERR(1:40)
731 :
732 : GOTO 9999
733 : ENDIF
734 : SEGSUP MLMOTS
735 : C
736 : C**** NINC = nombre d'inconnues
737 : C
738 : NINC=(IDIM+3)*2
739 : C
740 : TYPE='LISTMOTS'
740 : CALL LIROBJ(TYPE,ILIINC,1,IRET)
741 : IF(IERR .NE. 0) GOTO 9999
742 : MLMOTS = ILIINC
743 : SEGACT MLMOTS
744 : NC = MLMOTS.MOTS(/2)
745 : SEGDES MLMOTS
746 : IF(NC .NE. NINC)THEN
747 : MOTERR(1:40) = 'LISTINCO = ???'
748 : WRITE(IOIMP,*) MOTERR
749 : C
750 : C******* Message d'erreur standard
751 : C 21 2
752 : C Données incompatibles
753 : C
753 : CALL ERREUR(21)
754 : GOTO 9999
755 : ENDIF
756 : C
757 : C**** Lecture du CHAMPOINT ou du REEL contenant K0
758 : C
759 : IF (INDK0 .EQ. 1) THEN
760 : ICOND = 1
760 : CALL LIRREE(K0, ICOND, IRET)
761 : IF(IERR .NE. 0)GOTO 9999
762 : ELSE
763 : TYPE='CHPOINT '
764 : ICOND = 1
764 : CALL LIROBJ(TYPE,ICHPK0,ICOND,IRET)
765 : IF(IERR .NE. 0)GOTO 9999
766 : INDIC = 1
767 : NBCOMP = 1
768 : MOT1(1) = 'SCAL'
768 : CALL QUEPOI(ICHPK0, MELEMC, INDIC, NBCOMP, MOT1)
769 : IF(IERR .NE. 0) GOTO 9999
770 : ENDIF
771 : C
772 : C**** Lecture de EPS
773 : C
774 : ICOND = 1
774 : CALL LIRREE(EPS, ICOND, IRET)
775 : IF(IERR .NE. 0)GOTO 9999
776 : C
777 : C**** Boundary condition
778 : C
779 : IRET=0
780 : TYPE='MAILLAGE'
780 : CALL LIROBJ(TYPE,IFLIM,0,IRET)
781 : IF(IERR.NE.0)GOTO 9999
782 : IF(IRET .EQ. 0)THEN
783 : MELLIM = 0
784 : ELSE
785 : MELEME=IFLIM
786 : SEGACT MELEME
787 : ITOTO=MELEME.NUM(/2)
788 : IF(ITOTO .EQ. 0)THEN
789 : MELLIM = 0
790 : ELSE
791 : MELLIM = IFLIM
792 : ENDIF
793 : SEGDES MELEME
794 : ENDIF
795 : C
796 : C**** Bas Mach (AUSMPUP)
797 : C
798 : IF(INDMET .EQ. 3) THEN
799 : TYPE = 'CHPOINT '
800 : C
801 : C******* Reference speed
802 : C
802 : CALL LIROBJ(TYPE,IUINF1,1,IRET)
803 : IF(IERR .NE. 0) GOTO 9999
804 : INDIC = 1
805 : NBCOMP = 1
806 : MOT1(1) = 'SCAL'
806 : CALL QUEPOI(IUINF1, MELEMC, INDIC, NBCOMP, MOT1)
807 : IF(IERR .NE. 0) GOTO 9999
808 : C
809 : C******* Minimal cutoff
810 : C
811 : TYPE = 'CHPOINT '
811 : CALL LIROBJ(TYPE,IUINF2,1,IRET)
812 : IF(IERR .NE. 0) GOTO 9999
813 : INDIC = 1
814 : NBCOMP = 1
815 : MOT1(1) = 'SCAL'
815 : CALL QUEPOI(IUINF2, MELEMC, INDIC, NBCOMP, MOT1)
816 : IF(IERR .NE. 0) GOTO 9999
817 : C
818 : ELSE
819 : IUINF1=0
820 : IUINF2=0
821 : ENDIF
822 : C
823 : C write(*,*) 'Son qui dopo la lettura degli inputs'
824 : C
825 : C**** Creation du residu
826 : C
827 : TYPE = 'CHPOINT '
827 : CALL KRCHP1(TYPE, MELEMC, ICHRES, MLMOTS)
828 : C
829 : C**** Calcul des flux et du pas du temps.
830 : C
830 : CALL KODFL1(INDK0,NESP,NORD,TMAX,RUNIV,PROPHY,
831 : & MLRCHE,MLRMFR,
832 : & INDMET,
833 : & IALP1, IALP2,
834 : & IALF1,IROF1,IVITF1,IPF1,
835 : & IALF2,IROF2,IVITF2,IPF2,
836 : & IUINF1, IUINF2,
837 : & K0,ICHPK0,
838 : & IGRALP,EPS,
839 : & ICHPSU,ICHPDI,ICHPVO,
840 : & MELEMC,MELEMF,MELEFE,MELLIM,
841 : & ICHRES,
842 : & DT,SURFL,
843 : & LOGNC,LOGAN,MESERR)
844 : C
845 : IF(LOGAN)THEN
846 : C
847 : C******* Anomalie detectée
848 : C
849 : C
850 : C******* Message d'erreur standard
851 : C -301 0
852 : C %m1:40
853 : C
854 : MOTERR(1:40) = MESERR(1:40)
855 : WRITE(IOIMP,*) MOTERR(1:40)
856 : C
857 : C******* Message d'erreur standard
858 : C 5 3
859 : C Erreur anormale.contactez votre support
860 : C
860 : CALL ERREUR(5)
861 : GOTO 9999
862 : ENDIF
863 : IF(LOGNC)THEN
864 : C
865 : C******* Message d'erreur standard
866 : C -301 0
867 : C %m1:40
868 : C
869 : MOTERR(1:40) = MESERR(1:40)
870 : WRITE(IOIMP,*) MOTERR(1:40)
871 : C
872 : C******* Message d'erreur standard
873 : C 460 2
874 : C Pas de convergence dans les itérations internes
875 : C
875 : CALL ERREUR(460)
876 : GOTO 9999
877 : ENDIF
878 : C
879 : C**** Ecriture des resultats
880 : C
880 : CALL ECRREE(SURFL)
880 : CALL ECRREE(DT)
881 : TYPE = 'CHPOINT '
881 : IF(ICHRES .NE. 0) CALL ECROBJ(TYPE,ICHRES)
882 : C
883 : SEGSUP PROPHY
884 : C
885 : 9999 CONTINUE
886 : RETURN
887 : END
888 :
889 :
890 :
891 :
892 :
893 :
894 :
895 :
896 :
897 :
898 :
899 :
900 :
901 :
902 :
903 :
904 :
© Cast3M 2003 - All rights reserved.
Disclaimer