1 : C PRIMI1 SOURCE CHAT 06/03/29 21:30:22 5360
2 : SUBROUTINE PRIMI1()
3 : C************************************************************************
4 : C
5 : C PROJET : CASTEM 2000
6 : C
7 : C NOM : PRIMI1
8 : C
9 : C DESCRIPTION : Voir PRIMIT
10 : C
11 : C Calcul des variables primitives (et du "gamma")
12 : C pour les gaz "thermally perfect" mono/multiespeces
13 : C
14 : C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
15 : C
16 : C AUTEUR : A. BECCANTINI, DRN/DMT/SEMT/TTMF
17 : C
18 : C************************************************************************
19 : C
20 : C
21 : C APPELES (E/S) : LIRENT, ACMO, LIROBJ, QUEPOI, ERREUR, ECROBJ
22 : C
23 : C APPELES (Calcul) : PRIMI2
24 : C
25 : C
26 : C************************************************************************
27 : C
28 : C
29 : C PHRASE D'APPEL (GIBIANE) :
30 : C
31 : C 2) gaz "thermally" parfait mono/multi-especes (NESP > ou = 1)
32 : C
33 : C RCHPO1 RCHPO2 RCHPO3 (RCHPO4) RCHPO5 = 'PRIM' MCLE1 TAB1
34 : C CHPO1 CHPO2 CHPO3 (CHPO4) (CHPO5) (MCLE2) ;
35 : C
36 : C
37 : C ENTREES :
38 : C
39 : C MCLE1 : 'PERFMULT' : mot clé
40 : C
41 : C
42 : C TAB1 : TABLE qui contient :
43 : C * les noms des especes qui apparessent
44 : C explicitement dans les equations d'Euler en
45 : C TAB1 . 'ESPEULE' (LISTMOTS).
46 : C Dans le cas monoespece TAB1 . 'ESPEULE'
47 : C n'existe pas;
48 : C * le nom de l'espece qui n'y est pas (mots), en
49 : C TAB1 . 'ESPNEULE' (MOT).
50 : C * le degre k des polynoms cv_i(T)
51 : C * les CV du gas, supposes etre des polynoms du
52 : C k-eme degre, i.e.
53 : C CV_i = \sum_{j=0,k} A_{i,j} T^j (en J/Kg/K) ;
54 : C Ils sont stokes, pour l'espece 'ESPI', dans la
55 : C forme:
56 : C TAB1 . 'ESPI' . 'A' = 'PROG' A_0, ..., A_k
57 : C * Les constantes du gaz R_i; pour l'espece 'ESPI'
58 : C TAB1 . 'ESPI' . 'R' (en J/Kg/K)
59 : C * Les "energies de formation" a 0K, definies par
60 : C e_{0,i} = h_{0,i} = h_{T_0,i} - {R_i * T_0 +
61 : C {\sum_{j=0,k} A_{i,j} / (j+1) T_0^(j+1)}};
62 : C Elles sont stokes, pour l'espece 'ESPI', dans
63 : C la forme
64 : C TAB1 . 'ESPI' . 'H0K'
65 : C * (éventuellement) les noms de scalaires passifs qu'on
66 : C voudrait transporter en
67 : C TAB1 . 'SCALPASS' (LISTMOTS)
68 : C
69 : C CHPO1 : CHPOINT contenant la masse volumique (en Kg/m^3)
70 : C (une composante, 'SCAL').
71 : C
72 : C CHPO2 : CHPOINT contenant les dèbits (en m/s)
73 : C (2 composantes en 2D, 'UX ','UY ');
74 : C (3 composantes en 3D, 'UX ','UY ','UZ ');
75 : C
76 : C CHPO3 : CHPOINT contenat l'énergie totale per
77 : C unité de volume (RHO Et), (en J/m^3)
78 : C (une composante, 'SCAL').
79 : C
80 : C (CHPO4) : CHPOINT contenant la masse des especes qui sont
81 : C explicitement "splitted" dans les equations
82 : C d'Eulers (dont les noms sont dans
83 : C TAB1 . 'ESPEULE');
84 : C
85 : C (CHPO5) : CHPOINT contenant les scalaires passifs qu'on transporte,
86 : C multipliés par la masse volumique
87 : C (si existe TAB1 . 'SCALPASS');
88 : C
89 : C (CHPO6) : CHPOINT contenant la temperature de premier
90 : C essai pour la methode de Newton-Raphson (en K);
91 : C si il n'est pas donne' on prends T = 600K
92 : C
93 : C i.e. CHPO1, CHPO2, CHPO3, CHPO4 sont les variables
94 : C conservatives des Equations d'Euler.
95 : C
96 : C MCLE2 : Option personelle: pas dans la notice
97 : C officielle!!!
98 : C Mot clé, 'TRICHE' (s'il y a un erreur,
99 : C les resultats ne sont pas
100 : C des type ANNULLE et le programme
101 : C ne s'arrete pas!!!)
102 : C
103 : C SORTIES :
104 : C
105 : C RCHPO1 : CHPOINT contenant la vitesse
106 : C
107 : C RCHPO2 : CHPOINT contenant la pression du gaz;
108 : C
109 : C RCHPO3 : CHPOINT contenant la temperature du gaz;
110 : C
111 : C (RCHPO4) : CHPOINT contenant les fractions
112 : C massiques des differentes especes;
113 : C
114 : C (RCHPO5) : CHPOINT contenant les scalaire passifs;
115 : C
116 : C RCHPO6 : CHPOINT contenat les "gamma" du gaz
117 : C
118 : C N.B.:-tous les CHPOINTs sont non-partitonees et
119 : C ils ont le meme support geometrique;
120 : C en sortie tous les CHPOINTs ont le support
121 : C geometrique de RO
122 : C -en sortie RCHPO4 et CHPO4 ont les composantes ordonnees
123 : C dans le sens de TAB1 . 'ESPEULE'
124 : C
125 : C************************************************************************
126 : C
127 : C HISTORIQUE (Anomalies et modifications éventuelles)
128 : C
129 : C HISTORIQUE : Créée le 14.12.98.
130 : C
131 : C 10.02.2000:
132 : C Correction d'un erreur informatique (voir ligne CERR1),
133 : C qui apparait dans le cas d'un gaz avec deux espèces
134 : C
135 : C 11.02.2000:
136 : C on ajout la possibilité de considérer des scalaires
137 : C passifs
138 : C
139 : C
140 : C************************************************************************
141 : C
142 : C
143 : C**** Variables de COOPTIO
144 : C
145 : C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
146 : C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
147 : C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
148 : C & ,IECHO, IIMPI, IOSPI
149 : C & ,IDIM
150 : C & ,MCOORD
151 : C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
152 : C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
153 : C & ,NORINC,NORVAL,NORIND,NORVAD
154 : C & ,NUCROU, IPSAUV, IROSCA, NSCA, ISCA
155 : C
156 : C**** Les variables
157 : C
158 : IMPLICIT INTEGER(I-N)
159 : INTEGER ICOND, IRETOU, INDIC, NBCOMP, IERR0
160 : & , NESP, ICEN, IRO, IROVIT, IROET, IROY, IT
161 : & , IPGAS, IESP
162 : & , IPRES, IVIT, ITEMP, IY, IGAM
163 : & , I1, I2, JGM, JGN, NPOINT, NORD, NORDP1, NORD1
164 : REAL*8 VALER(2),VAL1,VAL2
165 : CHARACTER*(40) MESERR(2),MESCEL
166 : CHARACTER*(8) MTYPR
167 : CHARACTER*(6) NOMTRI
168 : CHARACTER*(4) MOT1(1)
169 : LOGICAL LOGNEG, LOGBOR, LOGAN, LOGTRI
170 : & ,LOGTEM, LOGIPG, LOGNC
171 : C
172 : C**** Variables en ACCTAB
173 : C
174 : INTEGER IVALI, IRETI,IVALR, IRETR
175 : REAL*8 XVALI, XVALR
176 : LOGICAL LOGII, LOGIR
177 : CHARACTER*(8) CHARR,MTYPI
178 : C
179 : C**** Segment des proprietes du gaz
180 : C
181 : SEGMENT PROPHY
182 : REAL*8 ACV(NORD+1,NESP+1), R(NESP+1), H0K(NESP+1)
183 : ENDSEGMENT
184 : C
185 : C**** Les Includes
186 : C
187 : -INC CCOPTIO
188 : -INC SMCHPOI
189 : -INC SMLMOTS
190 : -INC SMLREEL
191 : POINTEUR MLMOSC.MLMOTS
192 : C
193 : C**** Initialisation des parametres d'erreur
194 : C
195 : LOGAN = .FALSE.
196 : LOGNEG = .FALSE.
197 : LOGBOR = .FALSE.
198 : LOGNC = .FALSE.
199 : LOGIPG = .FALSE.
200 : MESCEL = ' '
201 : MESERR(1) = MESCEL
202 : MESERR(2) = MESCEL
203 : MOTERR(1:40) = MESCEL(1:40)
204 : VALER(1) = 0.0D0
205 : VALER(2) = 0.0D0
206 : VAL1 = 0.0D0
207 : VAL2 = 0.0D0
208 : C
209 : C**** Initialisation des variables en ACCTAB
210 : C
211 : IVALI = 0
212 : IVALR = 0
213 : XVALI = 0.0D0
214 : XVALR = 0.0D0
215 : LOGII = .FALSE.
216 : LOGIR = .FALSE.
217 : IRETI = 0
218 : IRETR = 0
219 : CHARR = ' '
220 : C
221 : C**** Initialisation des MOT1(1) (noms des composantes)
222 : C
223 : MOT1(1) = ' '
224 : C
225 : C**** N.B. On veut lire les objets sequentiellement.
226 : C Donc on utilise QUETYP pour controler que
227 : C le type de l'objet soit le bon.
228 : C
229 : C**** Lecture de la table des proprietes du gaz
230 : C
231 : ICOND = 1
231 : CALL QUETYP(MTYPR,ICOND,IRETOU)
232 : IF(IERR .NE. 0)GOTO 9999
233 : IF(MTYPR .NE. 'TABLE ')THEN
234 : C
235 : C******* Message d'erreur standard
236 : C 37 2
237 : C On ne trouve pas d'objet de type %m1:8
238 : C
239 : MOTERR(1:8) = 'TABLE '
239 : CALL ERREUR(37)
240 : GOTO 9999
241 : ELSE
242 : ICOND = 1
242 : CALL LIROBJ(MTYPR,IPGAS,ICOND,IRETOU)
243 : IF(IERR .NE. 0)GOTO 9999
244 : ENDIF
245 : C
246 : C**** Ordre des polynoms pour les cv_i
247 : C
248 : MTYPI = 'MOT '
249 : MTYPR = ' '
249 : CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,'NORD',LOGII,IRETI,
250 : & MTYPR,NORD,XVALR,CHARR,LOGIR,IESP)
251 : IF(MTYPR .NE. 'ENTIER ')THEN
252 : C
253 : C******* Message d'erreur standard
254 : C -301 0 %m1:40
255 : C
256 : MOTERR(1:40) = 'TAB1 . NORD = ??? '
257 : WRITE(IOIMP,*) MOTERR(1:40)
258 : C
259 : C******* Message d'erreur standard
260 : C 21 2
261 : C Données incompatibles
262 : C
262 : CALL ERREUR(21)
263 : GOTO 9999
264 : ENDIF
265 : NORDP1 = NORD + 1
266 : C
267 : C**** Nom de l'espece qui n'est pas dans les equations d'Euler
268 : C
269 : MTYPI = 'MOT '
270 : MTYPR = ' '
270 : CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,'ESPNEULE',LOGII,IRETI,
271 : & MTYPR,IVALR,XVALR,CHARR,LOGIR,IESP)
272 : IF(MTYPR .NE. 'MOT ')THEN
273 : C
274 : C******* Message d'erreur standard
275 : C -301 0 %m1:40
276 : C
277 : MOTERR(1:40) = 'TAB1 . ESPNEULE = ??? '
278 : WRITE(IOIMP,*) MOTERR(1:40)
279 : C
280 : C******* Message d'erreur standard
281 : C 21 2
282 : C Données incompatibles
283 : C
283 : CALL ERREUR(21)
284 : GOTO 9999
285 : ENDIF
286 : C
287 : C**** Les especes qui sont dans les Equations d'Euler
288 : C
289 : MTYPR = ' '
289 : CALL ACMO(IPGAS,'ESPEULE',MTYPR,MLMOT1)
290 : IF(MTYPR .EQ. ' ')THEN
291 : NESP = 0
292 : IROY = 0
293 : JGN = 4
294 : JGM = 1
295 : C
296 : C******* JGN,JGM en MLMOT2:
297 : C CHARACTER*(JGN) MOTS(JGM)
298 : C
299 : SEGINI MLMOT2
300 : MLMOT2.MOTS(1) = CHARR(1:4)
301 : ELSEIF(MTYPR .NE. 'LISTMOTS')THEN
302 : C
303 : C******* Message d'erreur standard
304 : C -301 0 %m1:40
305 : C
306 : MOTERR(1:40) = 'TAB1 . ESPEULE = ??? '
307 : WRITE(IOIMP,*) MOTERR(1:40)
308 : C
309 : C******* Message d'erreur standard
310 : C 21 2
311 : C Données incompatibles
312 : C
312 : CALL ERREUR(21)
313 : GOTO 9999
314 : ELSE
315 : SEGACT MLMOT1
316 : NESP = MLMOT1.MOTS(/2)
317 : JGN = 4
318 : JGM = NESP + 1
319 : SEGINI MLMOT2
320 : DO I1 = 1, NESP
321 : MLMOT2.MOTS(I1) = MLMOT1.MOTS(I1)
322 : ENDDO
323 : MLMOT2.MOTS(NESP+1)=CHARR(1:4)
324 : SEGDES MLMOT1
325 : ENDIF
326 : C
327 : C**** Les scalaires passifs qui sont dans les Equations d'Euler
328 : C
329 : MTYPR = ' '
329 : CALL ACMO(IPGAS,'SCALPASS',MTYPR,MLMOSC)
330 : IF(MTYPR .EQ. ' ')THEN
331 : NSCA = 0
332 : IROSCA = 0
333 : ELSEIF(MTYPR .NE. 'LISTMOTS')THEN
334 : C
335 : C******* Message d'erreur standard
336 : C -301 0 %m1:40
337 : C
338 : MOTERR(1:40) = 'TAB1 . SCALPASS = ??? '
339 : WRITE(IOIMP,*) MOTERR(1:40)
340 : C
341 : C******* Message d'erreur standard
342 : C 21 2
343 : C Données incompatibles
344 : C
344 : CALL ERREUR(21)
345 : GOTO 9999
346 : ELSE
347 : SEGACT MLMOSC
348 : NSCA = MLMOSC.MOTS(/2)
349 : SEGDES MLMOSC
350 : ENDIF
351 : C
352 : C**** On rempli les segment PROPHY
353 : C Ordre: IPGAS . 'ESPEULE' + IPGAS . 'ESPNEULE'
354 : C On controlle aussi la compatibilite des
355 : C donnes de la table
356 : C
357 : SEGINI PROPHY
358 : C
359 : C**** N.B. MOT1 est un CHARACTER*(4)
360 : C
361 : DO I1 = 1, NESP+1
362 : MOT1(1) = MLMOT2.MOTS(I1)
363 : C
363 : C******* CALL ACMF(...) ne marche pas parce que on a
364 : C des blanches dans nos composantes
365 : C
366 : MTYPI = 'MOT '
367 : MTYPR = ' '
367 : CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,MOT1(1), LOGII,IRETI,
368 : & MTYPR,IVALR,XVALR,CHARR,LOGIR,IESP)
369 : C
370 : C******* En IESP a la table IPGAS.MOT1(1)
371 : C
372 : IF((IERR .NE. 0) .OR. (MTYPR .NE. 'TABLE ')) THEN
373 :
374 : C
375 : C********** Message d'erreur standard
376 : C -301 0 %m1:40
377 : C
378 : MOTERR = ' '
379 : MOTERR(1:7) = 'TAB1 . '
380 : MOTERR(8:11) = MOT1(1)
381 : MOTERR(13:17) = '= ???'
382 : WRITE(IOIMP,*) MOTERR(1:40)
383 : C
384 : C********** Message d'erreur standard
385 : C 21 2
386 : C Données incompatibles
387 : C
387 : CALL ERREUR(21)
388 : GOTO 9999
389 : ENDIF
390 : C
391 : C******* R
392 : C
393 : MTYPI = 'MOT '
394 : MTYPR = ' '
394 : CALL ACCTAB(IESP,MTYPI,IVALI,XVALI, 'R' , LOGII,IRETI,
395 : & MTYPR,IVALR, XVALR ,CHARR,LOGIR,IRETR)
396 : IF((IERR .NE. 0) .OR. (MTYPR .NE. 'FLOTTANT')) THEN
397 : C
398 : C********** Message d'erreur standard
399 : C -301 0 %m1:40
400 : C
401 : MOTERR = ' '
402 : MOTERR(1:7) = 'TAB1 . '
403 : MOTERR(8:11) = MOT1(1)
404 : MOTERR(13:23) = ' . R = ??? '
405 : WRITE(IOIMP,*) MOTERR(1:40)
406 : C
407 : C********** Message d'erreur standard
408 : C 21 2
409 : C Données incompatibles
410 : C
410 : CALL ERREUR(21)
411 : GOTO 9999
412 : ENDIF
413 : PROPHY.R(I1)=XVALR
414 : C
415 : C******* H0K
416 : C
417 : MTYPI = 'MOT '
418 : MTYPR = ' '
418 : CALL ACCTAB(IESP,MTYPI,IVALI,XVALI, 'H0K' , LOGII,IRETI,
419 : & MTYPR,IVALR, XVALR ,CHARR,LOGIR,IRETR)
420 : IF((IERR .NE. 0) .OR. (MTYPR .NE. 'FLOTTANT')) THEN
421 :
422 : C
423 : C********** Message d'erreur standard
424 : C -301 0 %m1:40
425 : C
426 : MOTERR = ' '
427 : MOTERR(1:7) = 'TAB1 . '
428 : MOTERR(8:11) = MOT1(1)
429 : MOTERR(13:25) = ' . H0K = ??? '
430 : WRITE(IOIMP,*) MOTERR(1:40)
431 : C
432 : C********** Message d'erreur standard
433 : C 21 2
434 : C Données incompatibles
435 : C
435 : CALL ERREUR(21)
436 : GOTO 9999
437 : ENDIF
438 : PROPHY.H0K(I1)=XVALR
439 : C
440 : C******* A
441 : C
442 : MTYPI = 'MOT '
443 : MTYPR = ' '
443 : CALL ACCTAB(IESP,MTYPI,IVALI,XVALI, 'A' , LOGII,IRETI,
444 : & MTYPR,IVALR, XVALR ,CHARR,LOGIR,IRETR)
445 : IF((IERR .NE. 0) .OR. (MTYPR .NE. 'LISTREEL')) THEN
446 :
447 : C
448 : C********** Message d'erreur standard
449 : C -301 0 %m1:40
450 : C
451 : MOTERR = ' '
452 : MOTERR(1:7) = 'TAB1 . '
453 : MOTERR(8:11) = MOT1(1)
454 : MOTERR(13:23) = ' . A = ??? '
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 : ENDIF
463 : MLREEL = IRETR
464 : SEGACT MLREEL
465 : NORD1 = MLREEL.PROG(/1)
466 : IF(NORD1 .NE. NORDP1)THEN
467 : C
468 : C********** Message d'erreur standard
469 : C -301 0 %m1:40
470 : C
471 : MOTERR = ' '
472 : MOTERR(1:10) = 'DIME(TAB1.'
473 : MOTERR(11:14) = MOT1(1)
474 : MOTERR(15:37) = '.A) != (TAB1.NORD) + 1'
475 : WRITE(IOIMP,*) MOTERR(1:40)
476 : C
477 : C********** Message d'erreur standard
478 : C 21 2
479 : C Données incompatibles
480 : C
480 : CALL ERREUR(21)
481 : GOTO 9999
482 : ENDIF
483 :
484 : C
485 : C******* Dans le calcul, c'est plus utile ACV dans la forme
486 : C ACV(exponente,espece)
487 : C
488 : DO I2 = 1, NORDP1
489 : PROPHY.ACV(I2,I1)= MLREEL.PROG(I2)
490 : ENDDO
491 : SEGDES MLREEL
492 : ENDDO
493 : SEGSUP MLMOT2
494 : C
495 : C**** La table IPGAS donc a ete controllee et PROPHY est rempli
496 : C
497 : C
498 : C**** Lecture du CHPOINT CHPO1 (masse volumique totale)
499 : C
500 : ICOND = 1
500 : CALL QUETYP(MTYPR,ICOND,IRETOU)
501 : IF(IERR .NE. 0)GOTO 9999
502 : IF(MTYPR .NE. 'CHPOINT ')THEN
503 : C
504 : C******* Message d'erreur standard
505 : C 37 2
506 : C On ne trouve pas d'objet de type %m1:8
507 : C
508 : MOTERR(1:8) = 'CHPOINT '
508 : CALL ERREUR(37)
509 : GOTO 9999
510 : ELSE
511 : ICOND = 1
511 : CALL LIROBJ(MTYPR,IRO,ICOND,IRETOU)
512 : IF(IERR .NE. 0)GOTO 9999
513 : ENDIF
514 : C
515 : C**** On cherche le pointeur de son maillage et on l'impose sur les
516 : C autres CHPOINTs
517 : C
518 : MCHPOI = IRO
519 : SEGACT MCHPOI
520 : MSOUPO = MCHPOI.IPCHP(1)
521 : SEGACT MSOUPO
522 : ICEN = MSOUPO.IGEOC
523 : SEGDES MSOUPO
524 : SEGDES MCHPOI
525 : C
526 : C**** Control du CHPOINT: QUEPOI
527 : C
528 : C INDIC = 1 -> on impose le pointeur du support geometrique (ICEN)
529 : C N.B. Le CHPOINT peut changer de structure pour
530 : C avoir SPG = ICEN!!!!
531 : C INDIC = 0 -> on ne fait que verifier le support geometrique
532 : C (ICEN). Si le SPG sont differents INDIC = -4 en sortie
533 : C
534 : C NBCOMP > 0 -> numero des composantes
535 : C
536 : C MOT1(1) = ' ' obligatoire s'on connais pas les noms des composantes
537 : C
538 : INDIC = 1
539 : NBCOMP = 1
540 : MOT1(1) = 'SCAL'
540 : CALL QUEPOI(IRO, ICEN, INDIC, NBCOMP, MOT1)
541 : IF(IERR .NE. 0)THEN
542 : IERR0 = IERR
543 :
544 : C
545 : C******** Message d'erreur standard
546 : C -301 0 %m1:40
547 : C
548 : MOTERR = 'CHPO1 = ??? '
549 : WRITE(IOIMP,*) MOTERR(1:40)
550 :
551 : GOTO 9999
552 : ENDIF
553 : C
554 : C**** Lecture du CHPOINT CHPO2( debits)
555 : C
556 : ICOND = 1
556 : CALL QUETYP(MTYPR,ICOND,IRETOU)
557 : IF(IERR .NE. 0)GOTO 9999
558 : IF(MTYPR .NE. 'CHPOINT ')THEN
559 : C
560 : C******* Message d'erreur standard
561 : C 37 2
562 : C On ne trouve pas d'objet de type %m1:8
563 : C
564 : MOTERR(1:8) = 'CHPOINT '
564 : CALL ERREUR(37)
565 : GOTO 9999
566 : ELSE
567 : ICOND = 1
567 : CALL LIROBJ(MTYPR,IROVIT,ICOND,IRETOU)
568 : IF(IERR .NE. 0)GOTO 9999
569 : ENDIF
570 : C
571 : C**** Control du CHPOINT
572 : C
573 : C
574 : CERR2
575 : C
576 : JGN = 4
577 : JGM = IDIM
578 : SEGINI MLMOTS
579 : MLMOTS.MOTS(1) = 'UX '
580 : MLMOTS.MOTS(2) = 'UY '
581 : IF(IDIM .EQ. 3) MLMOTS.MOTS(3) = 'UZ '
582 : C
583 : C**** On controlle l'ordre de composantes de IROVIT
584 : C
584 : CALL QUEPO1(IROVIT, ICEN, MLMOTS)
585 : IF(IERR .NE. 0)THEN
586 : IERR0 = IERR
587 :
588 : C
589 : C******** Message d'erreur standard
590 : C -301 0 %m1:40
591 : C
592 : MOTERR = 'CHPO2 = ??? '
593 : WRITE(IOIMP,*) MOTERR(1:40)
594 :
595 : GOTO 9999
596 : ENDIF
597 : C
598 : C**** Lecture du CHPOINT CHPO3 (energie volumique)
599 : C
600 : ICOND = 1
600 : CALL QUETYP(MTYPR,ICOND,IRETOU)
601 : IF(IERR .NE. 0)GOTO 9999
602 : IF(MTYPR .NE. 'CHPOINT ')THEN
603 : C
604 : C******* Message d'erreur standard
605 : C 37 2
606 : C On ne trouve pas d'objet de type %m1:8
607 : C
608 : MOTERR(1:8) = 'CHPOINT '
608 : CALL ERREUR(37)
609 : GOTO 9999
610 : ELSE
611 : ICOND = 1
611 : CALL LIROBJ(MTYPR,IROET,ICOND,IRETOU)
612 : IF(IERR .NE. 0)GOTO 9999
613 : ENDIF
614 : C
615 : C**** Control du CHPOINT
616 : C
617 : INDIC = 1
618 : NBCOMP = 1
619 : MOT1(1) = 'SCAL'
619 : CALL QUEPOI(IROET, ICEN, INDIC, NBCOMP, MOT1)
620 : IF(IERR .NE. 0)THEN
621 : IERR0 = IERR
622 :
623 : C
624 : C******** Message d'erreur standard
625 : C -301 0 %m1:40
626 : C
627 : MOTERR = 'CHPO3 = ??? '
628 : WRITE(IOIMP,*) MOTERR(1:40)
629 :
630 : GOTO 9999
631 : ENDIF
632 : C
633 : C**** Lecture du CHPOINT CHPO4(masses volumiques des especes "splittees")
634 : C
635 : CERR1 IF(NESP .GT. 1)THEN: erreur: NESP = 0 dans le cas monoespece
636 : C NESP > 0 dans le cas multiespece
637 : IF(NESP .GE. 1)THEN
638 : ICOND = 1
638 : CALL QUETYP(MTYPR,ICOND,IRETOU)
639 : IF(IERR .NE. 0)GOTO 9999
640 : IF(MTYPR .NE. 'CHPOINT ')THEN
641 : C
642 : C******* Message d'erreur standard
643 : C 37 2
644 : C On ne trouve pas d'objet de type %m1:8
645 : C
646 : MOTERR(1:8) = 'CHPOINT '
646 : CALL ERREUR(37)
647 : GOTO 9999
648 : ELSE
649 : ICOND = 1
649 : CALL LIROBJ(MTYPR,IROY,ICOND,IRETOU)
650 : IF(IERR .NE. 0)GOTO 9999
651 : ENDIF
652 : C
653 : C**** Control du CHPOINT
654 : C
654 : CALL QUEPO1(IROY , ICEN , MLMOT1)
655 : IF(IERR .NE. 0)THEN
656 :
657 : C
658 : C******* Message d'erreur standard
659 : C -301 0 %m1:40
660 : C
661 : MOTERR = 'CHPO4 = ??? '
662 : WRITE(IOIMP,*) MOTERR(1:40)
663 : C
664 : C******* Message d'erreur standard
665 : C 21 2
666 : C Données incompatibles
667 : C
667 : CALL ERREUR(21)
668 : GOTO 9999
669 : ENDIF
670 : ENDIF
671 : C
672 : C**** Lecture du CHPOINT CHPO5 (scalaires passifs * densité)
673 : C
674 : IF(NSCA .GE. 1)THEN
675 : ICOND = 1
675 : CALL QUETYP(MTYPR,ICOND,IRETOU)
676 : IF(IERR .NE. 0)GOTO 9999
677 : IF(MTYPR .NE. 'CHPOINT ')THEN
678 : C
679 : C******* Message d'erreur standard
680 : C 37 2
681 : C On ne trouve pas d'objet de type %m1:8
682 : C
683 : MOTERR(1:8) = 'CHPOINT '
683 : CALL ERREUR(37)
684 : GOTO 9999
685 : ELSE
686 : ICOND = 1
686 : CALL LIROBJ(MTYPR,IROSCA,ICOND,IRETOU)
687 : IF(IERR .NE. 0)GOTO 9999
688 : ENDIF
689 : C
690 : C**** Control du CHPOINT
691 : C
691 : CALL QUEPO1(IROSCA , ICEN , MLMOSC)
692 : IF(IERR .NE. 0)THEN
693 :
694 : C
695 : C******* Message d'erreur standard
696 : C -301 0 %m1:40
697 : C
698 : MOTERR = 'CHPO5 = ??? '
699 : WRITE(IOIMP,*) MOTERR(1:40)
700 : C
701 : C******* Message d'erreur standard
702 : C 21 2
703 : C Données incompatibles
704 : C
704 : CALL ERREUR(21)
705 : GOTO 9999
706 : ENDIF
707 : ENDIF
708 : C
709 : C**** Lecture du CHPOINT CHPO6(temperature de tentative, optionelle)
710 : C
711 : ICOND = 0
712 : MTYPR = 'CHPOINT '
712 : CALL LIROBJ(MTYPR,IT,ICOND,IRETOU)
713 : IF(IERR .NE. 0)GOTO 9999
714 : IF(IRETOU .EQ. 1)THEN
715 : C
716 : C****** Control du CHPOINT
717 : C
718 : INDIC = 1
719 : NBCOMP = 1
720 : MOT1(1) = 'SCAL'
720 : CALL QUEPOI(IT, ICEN, INDIC, NBCOMP, MOT1)
721 : IF(IERR .NE. 0)THEN
722 : IERR0 = IERR
723 :
724 : C
725 : C*********** Message d'erreur standard
726 : C -301 0 %m1:40
727 : C
728 : MOTERR = 'CHPO6 = ??? '
729 : WRITE(IOIMP,*) MOTERR(1:40)
730 :
731 : GOTO 9999
732 : ENDIF
733 : LOGTEM = .TRUE.
734 : ELSE
735 : IT = 0
736 : LOGTEM = .FALSE.
737 : ENDIF
738 : C
739 : C*** Option TRICHE (optionelle et secrete)
740 : C
741 : ICOND = 0
741 : CALL LIRCHA(NOMTRI,ICOND,IRETOU)
742 : IF(IERR .NE. 0)GOTO 9999
743 : IF(IRETOU .NE. 0)THEN
744 : IF(NOMTRI .EQ. 'TRICHE')THEN
745 : LOGTRI = .TRUE.
746 : ELSE
747 : LOGTRI = .FALSE.
747 : CALL ECRCHA(NOMTRI)
748 : ENDIF
749 : ELSE
750 : LOGTRI = .FALSE.
751 : ENDIF
752 : C
753 : C**** Calcul des sorties.
754 : C
755 : C Jusque a la NESP = nombre d'especes qui apparessent
756 : C dans les equations d'Euler
757 : C
758 : C Maintenant NESP = nombre total d'espece
759 : C
760 : NESP = NESP + 1
760 : CALL PRIMI2(NESP,NORDP1,NSCA,PROPHY,
761 : & ICEN,IRO,IROVIT,IROET,IROY,IROSCA,LOGTEM,IT,
762 : & IVIT,IPRES,ITEMP,IY,ISCA,IGAM,
763 : & LOGAN,LOGNEG,LOGBOR,LOGIPG,LOGNC,MESERR,
764 : & VALER,VAL1,VAL2)
765 : C
766 : IF(LOGAN)THEN
767 : C
768 : C******* Message d'erreur standard
769 : C 5 3
770 : C Erreur anormale.contactez votre support
771 : C
771 : CALL ERREUR(5)
772 : GOTO 9999
773 : ELSE
774 : IF(LOGIPG)THEN
775 : C
776 : C********** CV(T) < 0
777 : C
778 : C
779 : C********** Message d'erreur standard
780 : C -301 0 %m1:40
781 : C
782 : MOTERR(1:40) = 'cv(T) < 0 ? R < 0 ? '
783 : WRITE(IOIMP,*) MOTERR(1:40)
784 : MOTERR(1:40) = 'TAB1 = ??? '
785 : WRITE(IOIMP,*) MOTERR(1:40)
786 : C
787 : C********** Message d'erreur standard
788 : C 21 2
789 : C Données incompatibles
790 : C
790 : CALL ERREUR(21)
791 : IF(LOGTRI)THEN
792 : IERR = 0
793 : ELSE
794 : GOTO 9999
795 : ENDIF
796 : ENDIF
797 : IF(LOGNC)THEN
798 : C
799 : C********** Newton - Raphson ne converge pas !!!
800 : C
801 : C
802 : C********** Message d'erreur standard
803 : C -301 0 %m1:40
804 : C
805 : MOTERR(1:40) = 'Newton - Raphson '
806 : WRITE(IOIMP,*) MOTERR(1:40)
807 : C
808 : C********** Message d'erreur standard
809 : C 460 2
810 : C Pas de convergence dans les itérations internes
811 : C
811 : CALL ERREUR(460)
812 : IF(LOGTRI)THEN
813 : IERR = 0
814 : ELSE
815 : GOTO 9999
816 : ENDIF
817 : ENDIF
818 : IF(LOGNEG)THEN
819 : C
820 : C******* Pression (energie thermique) ou densité negative
821 : C
822 : C
823 : C******* Message d'erreur standard
824 : C 41 2
825 : C %m1:8 = %r1 inférieur à %r2
826 : C
827 : MESCEL = MESERR(1)
828 : MOTERR(1:8) = MESCEL(1:8)
829 : REAERR(1) = REAL(VALER(1))
830 : REAERR(2) = 0.0
830 : CALL ERREUR(41)
831 : IF(LOGTRI)THEN
832 : * IERR = 0
833 : ELSE
834 : GOTO 9999
835 : ENDIF
836 : ENDIF
837 : IF(LOGBOR)THEN
838 : C
839 : C******* GAMMA !\in GAMMIN, GAMMAX
840 : C ou Y !\in YMIN,YMAX
841 : C
842 : C******* Message d'erreur standard
843 : C 42 2
844 : C %m1:8 = %r1 non compris entre %r2 et %r3
845 : C
846 : MESCEL = MESERR(2)
847 : MOTERR(1:8) = MESCEL(1:8)
848 : REAERR(1) = REAL(VALER(2))
849 : REAERR(2) = REAL(VAL1)
850 : REAERR(3) = REAL(VAL2)
850 : CALL ERREUR(42)
851 : IF(LOGTRI)THEN
852 : * IERR = 0
853 : ELSE
854 : GOTO 9999
855 : ENDIF
856 : ENDIF
857 : C
858 : C******* Ecriture du CHPOINT contenant les "gamma".
859 : C
859 : CALL ECROBJ('CHPOINT',IGAM)
860 : C
861 : C******* Ecriture du CHPOINT contenant les scalaires passifs.
862 : C
862 : IF(ISCA .NE. 0) CALL ECROBJ('CHPOINT',ISCA)
863 : C
864 : C******* Ecriture du CHPOINT contenant Y.
865 : C
865 : IF(IY .NE. 0) CALL ECROBJ('CHPOINT',IY)
866 : C
867 : C******* Ecriture du CHPOINT contenant la temperature.
868 : C
868 : CALL ECROBJ('CHPOINT',ITEMP)
869 : C
870 : C******* Ecriture du CHPOINT contenant la pression.
871 : C
871 : CALL ECROBJ('CHPOINT',IPRES)
872 : C
873 : C******* Ecriture du CHPOINT contenant la vitesse.
874 : C
874 : CALL ECROBJ('CHPOINT',IVIT)
875 : C
876 : ENDIF
877 : C
878 : SEGSUP PROPHY
879 : SEGSUP MLMOTS
880 : C
881 : 9999 CONTINUE
882 : C
883 : RETURN
884 : END
885 :
886 :
887 :
888 :
889 :
890 :
891 :
892 :
893 :
894 :
895 :
© Cast3M 2003 - All rights reserved.
Disclaimer