1 : C CKON SOURCE CHAT 06/08/24 21:20:16 5529 2 : SUBROUTINE CKON(KIZX) 3 : C************************************************************************ 4 : C 5 : C PROJET : CASTEM 2000 6 : C 7 : C NOM : CKON 8 : C 9 : C DESCRIPTION : Subroutine appellée par KONV 10 : C 11 : C Modelisation 2D/3D des equations d'Euler 12 : C 13 : C Calcul de flux aux interfaces 14 : C 15 : C LANGUAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI) 16 : C 17 : C AUTEUR : A. BECCANTINI, DRN/DMT/SEMT/TTMF 18 : C 19 : C************************************************************************ 20 : C 21 : C 22 : C APPELES (E/S) : ACMO, ERREUR, ACME, ACMM, LEKTAB, CRTABL, ECMM, 23 : C ECMO, ECMF 24 : C 25 : C 25 :
Warning: preg_replace(): Compilation failed: unmatched parentheses at offset 9 in C:\xampp\htdocs\cast3m_kit_local_fr_en_2014\sources.php on line 147
25 :
Warning: preg_replace(): Compilation failed: unmatched parentheses at offset 9 in C:\xampp\htdocs\cast3m_kit_local_fr_en_2014\sources.php on line 147
26 : C CKON3 (2D, gaz "thermally perfect") 27 : C CKON4 (3D, gaz "thermally perfect") 28 : C 29 : C************************************************************************ 30 : C 31 : C*** ENTREE 32 : C 33 : C Phrase d'appel (GIBIANE) : 34 : C 35 : C KONV TAB ; 36 : C 37 : C (NB: KIZX qui appairesse dans CKON(KIZX) est le pointeur de la 38 : C table TAB) 39 : C 40 : C La table de sous type KIZX a été généré par EQEX et 41 : C s'appelle RV.*KONV; elle contient differents arguments: 42 : C 43 : C 1) la table RV, généré par EQEX: 44 : C 45 : C KIZX . 'EQEX' 46 : C 47 : C 2) la table des options 48 : C 49 : C KIZX . 'KOPT' 50 : C 51 : C 3) la table domaine de KONV, 52 : C 53 : C KIZX . 'NOMZONE' 54 : C KIZX . 'DOMZ ' 55 : C 56 : C 4) tous les inconnues du probleme global 57 : C 58 : C KIZX . 'EQEX' . 'INCO' 59 : C 60 : C 5) la methode de calcul 61 : C 62 : C KIZX . 'KOPT' . 'IDCEN' 63 : C 64 : C 6) mono-espece, multi-especes, multi-especes "thermally perfect" 65 : C 66 : C KIZX . 'KOPT' . 'IDEUL' 67 : C 68 : C 69 : C 7) le variables primales de KONV, 70 : C i.e. les arguments de l'operateur KONV: 71 : C 72 : C KIZX . 'ARG1 ' 73 : C 74 : C KIZX . 'ARG2 ' 75 : C 76 : C ... 77 : C 78 : C 79 : C 8) la liste des variables duales, i.e. les inconnues traites par 80 : C KONV: 81 : C 82 : C KIZX . 'LISTINCO' 83 : C 84 : C 85 : C**** SORTIE 86 : C 87 : C 1) les Flux aux faces, sont conservés dans la table 88 : C 89 : C KIZX . 'EQEX' . 'KIZG' 90 : C 91 : C 2) la table PASDETPS (***A CHANGER***) 92 : C 93 : C 94 : C*********************************************************************** 95 : C 96 : C************************************************************************ 97 : C 98 : C HISTORIQUE (Anomalies et modifications éventuelles) 99 : C 100 : C HISTORIQUE : 101 : C 102 : C************************************************************************ 103 : C 104 : C 105 : C**** Variables de COOPTIO 106 : C 107 : C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR 108 : C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ 109 : C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES 110 : C & ,IECHO, IIMPI, IOSPI 111 : C & ,IDIM 112 : C & ,MCOORD 113 : C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE 114 : C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU 115 : C & ,NORINC,NORVAL,NORIND,NORVAD 116 : C & ,NUCROU, IPSAUV 117 : C 118 : IMPLICIT INTEGER(I-N) 119 : INTEGER KIZX, IEQEX, IKOPT, IDOMA, INCO 120 : & , IND, INDMET, INDEUL 121 : & , NBRINC 122 : & , NORD, NORDP1, IROF, IVITF, IPF, IGAMF 123 : & , IFRMAF 124 : & , LINCO 125 : & , MELEMC, MELEMF, MELEFE 126 : & , ICHPSU, ICHPDI 127 : & , KIZG, IZG1, IZG2, IZG3, IZG4, IZG5 128 : & , NLCEMI 129 : & , MTABT 130 : & , INDIC, NBCOMP, NESP, IPGAZ, NSCA, ISCAF 131 : & , IRET, IENT, I1, I2, IESP, JGM, JGN 132 : & , N, NAT, NC, NSOUPO, NCELL 133 : C 134 : REAL*8 DT, DIAMEL, XVAL 135 : CHARACTER*(8) TYPE,NOMZ,MOTLU 136 : CHARACTER*(8) ARG 137 : CHARACTER*(40) MESERR 138 : CHARACTER*(4) NOMTOT(2) 139 : LOGICAL LOGME, LOGNC, LOGAN, XLOGI, LOGSCA 140 : C 141 : C**** Variables en ACCTAB 142 : C 143 : INTEGER IVALI, IRETI,IVALR, IRETR, MMODEL, INEFMD 144 : REAL*8 XVALI, XVALR 145 : LOGICAL LOGII, LOGIR 146 : CHARACTER*(8) MTYPI, MTYPR, CHARR 147 : C 148 : C**** Segment des proprietes du gaz 149 : C 150 : SEGMENT PROPHY 151 : REAL*8 ACV(NORDP1,NESP+1), R(NESP+1), H0K(NESP+1) 152 : & ,ACVTOG(NORDP1), ACVTOD(NORDP1) 153 : ENDSEGMENT 154 : C 155 : C**** Les Includes. 156 : C 157 : -INC CCOPTIO 158 : -INC SMCHPOI 159 : -INC SMLMOTS 160 : POINTEUR MLMOEU.MLMOTS, MLMOSC.MLMOTS 161 : -INC SMLREEL 162 : -INC SMELEME 163 : C 164 : C**** Initialisation des variables pour la gestion des erreurs. 165 : C 166 : LOGNC = .FALSE. 167 : LOGAN = .FALSE. 168 : MESERR = ' ' 169 : 170 : C 171 : C**** Lecture de KIZX . 'EQEX'. (C'est le pointeur de la table RV) 172 : C 173 : IEQEX = 0 174 : TYPE = 'TABLE ' 174 : CALL ACMO(KIZX,'EQEX',TYPE,IEQEX) 175 : IF(IERR .NE. 0) GOTO 9999 176 : IF(TYPE .NE. 'TABLE ')THEN 177 : MOTERR(1:40) = 'EULER, subroutine ckon.eso, EQEX = ? ' 178 : C 179 : C******* Message d'erreur standard 180 : C -301 0 %m1:40 181 : C 181 : CALL ERREUR(-301) 182 : C 183 : C******* Message d'erreur standard 184 : C 21 2 185 : C Données incompatibles 186 : C 186 : CALL ERREUR(21) 187 : GO TO 9999 188 : ENDIF 189 : C 190 : C**** Lecture de KIZX . 'KOPT' (les optiones de KONV) 191 : C 192 : IKOPT = 0 193 : TYPE = 'TABLE ' 193 : CALL ACMO(KIZX,'KOPT',TYPE,IKOPT) 194 : IF(IERR .NE. 0) GOTO 9999 195 : IF(TYPE .NE. 'TABLE ')THEN 196 : MOTERR(1:40) = 'EULER, subroutine ckon.eso, EQEX = ? ' 197 : C 198 : C******* Message d'erreur standard 199 : C -301 0 %m1:40 200 : C 200 : CALL ERREUR(-301) 201 : C 202 : C On EQEX on a pas controlles qu'il n'y a pas KOPT 203 : C 204 : C******* Message d'erreur standard 205 : C 5 3 206 : C Erreur anormale.contactez votre support 207 : C 207 : CALL ERREUR(5) 208 : GO TO 9999 209 : ENDIF 210 : C 211 : C**** Lecture de KIZX . 'NOMZONE' (le domaine de KONV: le nom) 212 : C 212 : CALL ACMM(KIZX,'NOMZONE',NOMZ) 213 : IF(IERR .NE. 0)GOTO 9999 214 : C 215 : C**** Lecture de KIZX . 'DOMZ ' (le domaine de KONV: le pointeur) 216 : C 217 : IDOMA = 0 218 : TYPE = ' ' 218 : CALL ACMO(KIZX,'DOMZ ',TYPE,MMODEL) 219 : IF(IERR .NE. 0) GOTO 9999 220 : IF(TYPE .NE. 'MMODEL ')THEN 221 : MOTERR(1:40) = 'EULER, subroutine ckon.eso, ZONE = ? ' 222 : C 223 : C******* Message d'erreur standard 224 : C -301 0 %m1:40 225 : C 225 : CALL ERREUR(-301) 226 : C 227 : C******* Message d'erreur standard 228 : C 5 3 229 : C Erreur anormale.contactez votre support 230 : C 230 : CALL ERREUR(5) 231 : GO TO 9999 232 : ELSE 232 : CALL LEKMOD(MMODEL,IDOMA,INEFMD) 233 : ENDIF 234 : C 235 : C**** Lecture de KIZX . 'EQEX' . 'INCO'. 236 : C Le pointeur de la table qui contient toutes les inconnues du 237 : C probleme 238 : C 239 : TYPE = 'TABLE ' 239 : CALL ACMO(IEQEX,'INCO',TYPE,INCO) 240 : IF(IERR .NE. 0) GOTO 9999 241 : IF(TYPE .NE. 'TABLE ')THEN 242 : MOTERR(1:40) = 'EULER, subroutine ckon.eso, INCO = ? ' 243 : C 244 : C******* Message d'erreur standard 245 : C -301 0 %m1:40 246 : C 246 : CALL ERREUR(-301) 247 : C 248 : C******* Message d'erreur standard 249 : C 21 2 250 : C Données incompatibles 251 : C 251 : CALL ERREUR(21) 252 : GO TO 9999 253 : ENDIF 254 : C 255 : C 256 : C**** Model de gaz: 256 : C EULER mono-espece "calorically perfect" (IDEUL = 1) 256 : C EULER multi-espece "calorically perfect" (IDEUL = 2) 257 : C EULER multi-espece "thermally perfect" (IDEUL = 3) 258 : C 258 : CALL ACME(IKOPT,'IDEUL',INDEUL) 259 : IF(IERR .NE. 0) GOTO 9999 260 : IF((INDEUL .LT. 1) .OR. (INDEUL .GT. 3))THEN 261 : MOTERR(1:40) = 'EULER, subroutine ckon.eso, IDEUL = ? ' 262 : C 263 : C******** Message d'erreur standard 264 : C -301 0 %m1:40 265 : C 265 : CALL ERREUR(-301) 266 : C 267 : C******* Message d'erreur standard 268 : C 5 3 269 : C Erreur anormale.contactez votre support 270 : C 270 : CALL ERREUR(5) 271 : GOTO 9999 272 : ENDIF 273 : IF(INDEUL .LE. 2)THEN 274 : C 275 : C******************************************************************* 275 :
Warning: preg_replace(): Compilation failed: nothing to repeat at offset 9 in C:\xampp\htdocs\cast3m_kit_local_fr_en_2014\sources.php on line 147
276 : C******************************************************************* 277 : C 278 : IF(INDEUL .EQ.1)THEN 279 : LOGME = .FALSE. 280 : ELSE 281 : LOGME = .TRUE. 282 : ENDIF 283 : C 284 : C******* Lecture des options de KONV dans KIZX . 'KOPT' 285 : C 286 : C******* Metode utilisée 287 : C 287 : CALL ACME(IKOPT,'IDCEN',IND) 288 : IF(IERR .NE. 0) GOTO 9999 289 : IF(IND .EQ. 9)THEN 290 : C 291 : C********** GODUNOV 292 : C 293 : INDMET = 1 294 : ELSEIF(IND .EQ. 10)THEN 295 : C 296 : C********** Van Leer FVS 297 : C 298 : INDMET = 2 299 : ELSEIF(IND .EQ. 11)THEN 300 : C 301 : C********** Van Leer-HANEL FVS 302 : C 303 : INDMET = 3 304 : ELSEIF(IND .EQ. 12)THEN 305 : C 306 : C********** HUS (Van Leer FVS + Osher FDS) 307 : C 308 : INDMET = 4 309 : ELSEIF(IND .EQ. 13)THEN 310 : C 311 : C********** HUS (Van Leer-HANEL FVS + Osher FDS) 312 : C 313 : INDMET = 5 314 : ELSEIF(IND .EQ. 14)THEN 315 : C 316 : C********** AUSM 317 : C 318 : C INDMET = 6 319 : C ELSE 320 : C 321 : C********** Message d'erreur standard 322 : C 251 2 323 : C Tentative d'utilisation d'une option non implémentée 324 : C 324 : CALL ERREUR(251) 325 : ENDIF 326 : C 327 : C******* Lecture des arguments de KONV KIZX . 'ARG*' 328 : C 329 : C Lecture du MCHAML 'FACEL' contenant la masse volumique. 330 : C 331 : C D'abord on va lire son nom in KIZX . 'ARG1 ' -> MOTLU 332 : C 333 : MOTLU=' ' 333 : CALL ACMM(KIZX,'ARG1 ',MOTLU) 334 : IF(IERR.NE.0) GOTO 9999 335 : C 336 : C******* On va lire le pointeur du MCHAML 337 : C 338 : TYPE='MCHAML ' 338 : CALL ACMO(INCO,MOTLU,TYPE,IROF) 339 : IF(IERR.NE.0) GOTO 9999 340 : IF(TYPE .NE. 'MCHAML ')THEN 341 : C 342 : C********** Message d'erreur standard 343 : C 37 2 344 : C On ne trouve pas d'objet de type %m1:8 345 : C 346 : MOTERR(1:8) = 'MCHAML ' 346 : CALL ERREUR(37) 347 : GOTO 9999 348 : ENDIF 349 : C 350 : C******* Lecture du MCHAML 'FACEL' vitesse 351 : C 352 : MOTLU=' ' 352 : CALL ACMM(KIZX,'ARG2 ',MOTLU) 353 : IF(IERR.NE.0)GOTO 9999 354 : C 355 : TYPE='MCHAML ' 355 : CALL ACMO(INCO,MOTLU,TYPE,IVITF) 356 : IF(IERR .NE. 0) GOTO 9999 357 : IF(TYPE .NE. 'MCHAML ')THEN 358 : C 359 : C********** Message d'erreur standard 360 : C 37 2 361 : C On ne trouve pas d'objet de type %m1:8 362 : C 363 : MOTERR(1:8) = 'MCHAML ' 363 : CALL ERREUR(37) 364 : GOTO 9999 365 : ENDIF 366 : C 367 : C******** Lecture du MCHAML 'FACEL' contenant la pression 368 : C 369 : MOTLU=' ' 369 : CALL ACMM(KIZX,'ARG3 ',MOTLU) 370 : IF(IERR .NE. 0) GOTO 9999 371 : C 372 : TYPE='MCHAML ' 372 : CALL ACMO(INCO,MOTLU,TYPE,IPF) 373 : IF(IERR .NE. 0) GOTO 9999 374 : IF(TYPE .NE. 'MCHAML ')THEN 375 : C 376 : C********** Message d'erreur standard 377 : C 37 2 378 : C On ne trouve pas d'objet de type %m1:8 379 : C 380 : MOTERR(1:8) = 'MCHAML ' 380 : CALL ERREUR(37) 381 : GOTO 9999 382 : ENDIF 383 : C 384 : C******* Lecture du MCHAML 'FACEL' contenant les gamma 385 : C 386 : MOTLU=' ' 386 : CALL ACMM(KIZX,'ARG4 ',MOTLU) 387 : IF(IERR .NE. 0) GOTO 9999 388 : C 389 : TYPE='MCHAML ' 389 : CALL ACMO(INCO,MOTLU,TYPE,IGAMF) 390 : IF(IERR .NE. 0) GOTO 9999 391 : IF(TYPE .NE. 'MCHAML ')THEN 392 : C 393 : C********** Message d'erreur standard 394 : C 37 2 395 : C On ne trouve pas d'objet de type %m1:8 396 : C 397 : MOTERR(1:8) = 'MCHAML ' 397 : CALL ERREUR(37) 398 : GOTO 9999 399 : ENDIF 400 : C 401 : C******* Si LOGME -> MULTIESPECES 402 : C 403 : IF(LOGME)THEN 404 : C 405 : C********** Lecture du MCHAML 'FACEL' contenant les fractiones massiques 406 : C 407 : MOTLU=' ' 407 : CALL ACMM(KIZX,'ARG5 ',MOTLU) 408 : IF(IERR .NE. 0) GOTO 9999 409 : C 410 : TYPE='MCHAML ' 410 : CALL ACMO(INCO,MOTLU,TYPE,IFRMAF) 411 : IF(IERR .NE. 0) GOTO 9999 412 : IF(TYPE .NE. 'MCHAML ')THEN 413 : C 414 : C********** Message d'erreur standard 415 : C 37 2 416 : C On ne trouve pas d'objet de type %m1:8 417 : C 418 : MOTERR(1:8) = 'MCHAML ' 418 : CALL ERREUR(37) 419 : GOTO 9999 420 : ENDIF 421 : C 422 : C********** Lecture de la table qui contient le proprieté du gaz 423 : C 424 : MOTLU=' ' 424 : CALL ACMM(KIZX,'ARG6 ',MOTLU) 425 : IF(IERR .NE. 0) GOTO 9999 426 : C 427 : TYPE='TABLE ' 427 : CALL ACMO(INCO,MOTLU,TYPE,IPGAZ) 428 : IF(IERR .NE. 0) GOTO 9999 429 : IF(TYPE .NE. 'TABLE ')THEN 430 : C 431 : C************* Message d'erreur standard 432 : C 37 2 433 : C On ne trouve pas d'objet de type %m1:8 434 : C 435 : MOTERR(1:8) = 'TABLE ' 435 : CALL ERREUR(37) 436 : GOTO 9999 437 : ENDIF 438 : ENDIF 439 : C 440 : C******* Lecture de Nom des Inconnues de KONV (KIZX . 'LISTINCO') 441 : C 442 : TYPE='LISTMOTS' 442 : CALL ACMO(KIZX,'LISTINCO',TYPE,LINCO) 443 : MLMOT1 = LINCO 444 : IF(IERR.NE.0)GOTO 9999 445 : SEGACT MLMOT1 446 : C 447 : C******* Verification du Nombre d'inconnues. 448 : C 449 : C Eulero mono-especie -> NBRINC = 3 450 : C Eulero multi-especies -> NBRINC = 4 451 : C 452 : NBRINC = MLMOT1.MOTS(/2) 453 : IF(LOGME)THEN 454 : IF(NBRINC .NE. 4)THEN 455 : C 456 : C************* Message d'erreur standard 457 : C -301 0 %m1:40 458 : C 459 : MOTERR(1:40) = 'EULERMS: LISTINCO = ? ' 459 : CALL ERREUR(-301) 460 : C 461 : C************* Message d'erreur standard 462 : C 21 2 Données incompatibles 463 : C 463 : CALL ERREUR(21) 464 : GO TO 9999 465 : ENDIF 466 : ELSEIF(NBRINC .NE. 3)THEN 467 : C 468 : C********** Message d'erreur standard 469 : C -301 0 %m1:40 470 : C 471 : MOTERR(1:40) = 'EULER: LISTINCO = ? ' 471 : CALL ERREUR(-301) 472 : C 473 : C********** Message d'erreur standard 474 : C 21 2 Données incompatibles 475 : C 475 : CALL ERREUR(21) 476 : GO TO 9999 477 : ENDIF 478 : C 479 : C 480 : C******* Table DOMAINE en IDOMA (pointeur de la zone de KONV) 481 : C 482 : C 483 : C******* Lecture du MELEME SPG des points CENTRE. 484 : C 485 : C 485 : C CALL LEKTAB(IDOMA,'CENTRE',MELEMC) 486 : C 487 : C******* Probleme du LEKTAB: si IDOMA.'CENTRE' n'existe pas, 488 : C il crèe IDOMA.'CENTRE' sans recrèer 'FACEL' 489 : C -> la correspondance global des noeuds saut! 490 : C 491 : C On peut utilizer ACCTAB ou ACMO 492 : C 493 : TYPE = 'MAILLAGE' 493 : CALL ACMO(IDOMA,'CENTRE',TYPE,MELEMC) 494 : IF(IERR .NE. 0) GOTO 9999 495 : IF(TYPE .NE. 'MAILLAGE')THEN 496 : MOTERR(1:8) = NOMZ 497 : MOTERR(9:40) = ' . CENTRE = ? ' 498 : C 499 : C********** Message d'erreur standard 500 : C -301 0 %m1:40 501 : C 501 : CALL ERREUR(-301) 502 : C 503 : C********** Message d'erreur standard 504 : C 21 2 505 : C Données incompatibles 506 : C 506 : CALL ERREUR(21) 507 : GO TO 9999 508 : ENDIF 509 : C 510 : C******* Lecture du MELEME 'FACE' SPG des points FACE 511 : C 511 : CALL ACMO(IDOMA,'FACE',TYPE,MELEMF) 512 : IF(IERR .NE. 0) GOTO 9999 513 : IF(TYPE .NE. 'MAILLAGE')THEN 514 : MOTERR(1:8) = NOMZ 515 : MOTERR(9:40) = ' . FACE = ? ' 516 : C 517 : C********** Message d'erreur standard 518 : C -301 0 %m1:40 519 : C 519 : CALL ERREUR(-301) 520 : C 521 : C********** Message d'erreur standard 522 : C 21 2 523 : C Données incompatibles 524 : C 524 : CALL ERREUR(21) 525 : GO TO 9999 526 : ENDIF 527 : C 528 : C******* Lecture du MELEME 'FACEL' de connect. FACE -> CENTRE 529 : C 529 : CALL ACMO(IDOMA,'FACEL',TYPE,MELEFE) 530 : IF(IERR .NE. 0) GOTO 9999 531 : IF(TYPE .NE. 'MAILLAGE')THEN 532 : MOTERR(1:8) = NOMZ 533 : MOTERR(9:40) = ' . FACEL = ? ' 534 : C 535 : C******* Message d'erreur standard 536 : C -301 0 %m1:40 537 : C 537 : CALL ERREUR(-301) 538 : C 539 : C******* Message d'erreur standard 540 : C 21 2 541 : C Données incompatibles 542 : C 542 : CALL ERREUR(21) 543 : GO TO 9999 544 : ENDIF 545 : C 546 : C**** Lecture du CHPOINT contenant les surfaces des faces. 547 : C 547 : CALL LEKTAB(IDOMA,'XXSURFAC',ICHPSU) 548 : IF(IERR .NE. 0) GOTO 9999 549 : C 550 : C**** Lecture du CHPOINT contenant les diametres minimums. 551 : C 551 : CALL LEKTAB(IDOMA,'XXDIEMIN',ICHPDI) 552 : IF(IERR .NE. 0) GOTO 9999 553 : C 554 : C 555 : C**** Lecture de la TABLE contenant les FLUX aux interfaces, 556 : C i.e. KIZX . 'EQEX' . 'KIZG' 557 : C 558 : C N.B. On recuper le pointeur des flux relatives aux 559 : C inconnues de KONV. 560 : C 561 : TYPE= ' ' 561 : CALL ACMO(IEQEX,'KIZG',TYPE,KIZG) 562 : IF(IERR .NE. 0) GOTO 9999 563 : IF(TYPE .NE. 'TABLE ')THEN 563 : CALL CRTABL(KIZG) 563 : CALL ECMM(KIZG,'SOUSTYPE','KIZG') 563 : CALL ECMO(IEQEX,'KIZG','TABLE ',KIZG) 564 : ENDIF 565 : C 566 : C**** Creation des CHPOINTs increment IZG1-2-3-4 pour les FLUX 567 : C ou extraction des leurs pointeurs 568 : C 569 : C 570 : C**** La masse volumique 571 : C 572 : C 573 : TYPE=' ' 574 : ARG = MLMOT1.MOTS(1) 574 : CALL ACMO(KIZG,ARG,TYPE,IZG1) 575 : IF(IERR .NE. 0) GOTO 9999 576 : IF(TYPE .NE. 'CHPOINT ')THEN 577 : TYPE = 'FACE' 578 : NBCOMP = 1 578 : CALL CRCHPT(TYPE,MELEMF,NBCOMP,IZG1) 579 : IF(IERR .NE. 0)GOTO 9999 580 : C 581 : C******* Stokage du pointeur dans KIZG 582 : C 583 : ARG = MLMOT1.MOTS(1) 583 : CALL ECMO(KIZG,ARG,'CHPOINT ',IZG1) 584 : ELSE 585 : INDIC = 1 586 : NBCOMP = 1 587 : NOMTOT(1) = ' ' 587 : CALL QUEPOI(IZG1,MELEMF,INDIC,NBCOMP,NOMTOT) 588 : IF(IERR .NE. 0)GOTO 9999 589 : ENDIF 590 : C 591 : C**** Les debits 592 : C 593 : TYPE=' ' 594 : ARG = MLMOT1.MOTS(2) 594 : CALL ACMO(KIZG,ARG,TYPE,IZG2) 595 : IF(IERR .NE. 0) GOTO 9999 596 : IF(TYPE .NE. 'CHPOINT ')THEN 597 : TYPE='FACE' 598 : NBCOMP = IDIM 598 : CALL CRCHPT(TYPE,MELEMF,NBCOMP,IZG2) 599 : IF(IERR .NE. 0) GOTO 9999 600 : C 601 : C******* Stokage du pointeur dans KIZG 602 : C 603 : ARG = MLMOT1.MOTS(2) 603 : CALL ECMO(KIZG,ARG,'CHPOINT ',IZG2) 604 : ELSE 605 : INDIC = 1 606 : NBCOMP = IDIM 607 : NOMTOT(1) = ' ' 607 : CALL QUEPOI(IZG2,MELEMF,INDIC,NBCOMP,NOMTOT) 608 : IF(IERR .NE. 0)GOTO 9999 609 : ENDIF 610 : C 611 : C**** L'energie totale volumique 612 : C 613 : TYPE=' ' 614 : ARG = MLMOT1.MOTS(3) 614 : CALL ACMO(KIZG,ARG,TYPE,IZG3) 615 : IF(IERR .NE. 0) GOTO 9999 616 : IF(TYPE .NE. 'CHPOINT ')THEN 617 : TYPE='FACE' 618 : NBCOMP = 1 618 : CALL CRCHPT(TYPE,MELEMF,NBCOMP,IZG3) 619 : IF(IERR .NE. 0) GOTO 9999 620 : C 621 : C******* Stokage du pointeur dans KIZG 622 : C 623 : ARG = MLMOT1.MOTS(3) 623 : CALL ECMO(KIZG,ARG,'CHPOINT ',IZG3) 624 : ELSE 625 : INDIC = 1 626 : NBCOMP = 1 627 : NOMTOT(1) = ' ' 627 : CALL QUEPOI(IZG3,MELEMF,INDIC,NBCOMP,NOMTOT) 628 : IF(IERR .NE. 0)GOTO 9999 629 : ENDIF 630 : C 631 : C**** Les Masses Volumiques 632 : C 633 : IF(LOGME)THEN 634 : C 635 : C******* D'abord on extrait de la table de pointeur IPGAZ 636 : C la liste des especes splittes dans les equations 637 : C d'Euler 638 : C 639 : TYPE=' ' 639 : CALL ACMO(IPGAZ,'ESPEULE ',TYPE,MLMOT2) 640 : IF(IERR .NE. 0) GOTO 9999 641 : IF(TYPE .NE. 'LISTMOTS')THEN 642 : C 643 : C********** Message d'erreur standard 644 : C -301 0 %m1:40 645 : C 646 : MOTERR(1:40) = 'KONV, ARG6 . ESPEULE = ??? ' 646 : CALL ERREUR(-301) 647 : C 648 : C********** Message d'erreur standard 649 : C 21 2 650 : C Données incompatibles 651 : C 651 : CALL ERREUR(21) 652 : GOTO 9999 653 : ENDIF 654 : C 655 : SEGACT MLMOT2 656 : NESP = MLMOT2.MOTS(/2) 657 : C 658 : TYPE=' ' 659 : ARG = MLMOT1.MOTS(4) 659 : CALL ACMO(KIZG,ARG,TYPE,IZG4) 660 : IF(IERR .NE. 0) GOTO 9999 661 : IF(TYPE .NE. 'CHPOINT ')THEN 662 : NBCOMP = NESP 663 : TYPE='FACE ' 664 : C 665 : C********** On cree le chpoint FACE 666 : C 667 : IPT1 = MELEMF 668 : SEGACT IPT1 669 : N=IPT1.NUM(/2) 670 : SEGDES IPT1 671 : NSOUPO=1 672 : NAT=1 673 : NC = NESP 674 : SEGINI, MCHPOI,MSOUPO,MPOVAL 675 : MCHPOI.JATTRI(1)=2 676 : MCHPOI.IFOPOI=IFOMOD 677 : MCHPOI.MTYPOI=TYPE 678 : MCHPOI.MOCHDE(1:30)=' ' 679 : MCHPOI.MOCHDE(31:60)=' ' 680 : MCHPOI.MOCHDE(61:72)=' ' 681 : MCHPOI.IPCHP(1)=MSOUPO 682 : SEGDES MCHPOI 683 : MSOUPO.IGEOC=MELEMF 684 : MSOUPO.IPOVAL=MPOVAL 685 : DO I1 = 1, NC 686 : MSOUPO.NOCOMP(I1) = MLMOT2.MOTS(I1) 687 : ENDDO 688 : SEGDES, MSOUPO,MPOVAL 689 : IZG4 = MCHPOI 690 : C 691 : C********** Stokage du pointeur dans KIZG 692 : C 693 : ARG = MLMOT1.MOTS(4) 693 : CALL ECMO(KIZG,ARG,'CHPOINT ',IZG4) 694 : ELSE 695 : INDIC = 1 696 : NBCOMP = NESP 697 : NOMTOT(1) = ' ' 697 : CALL QUEPOI(IZG4,MELEMF,INDIC,NBCOMP,NOMTOT) 698 : IF(IERR .NE. 0)GOTO 9999 699 : ENDIF 700 : SEGDES MLMOT2 701 : ENDIF 702 : 703 : C 704 : C**** Calcul des flux et du pas du temps. 705 : C 706 : IF( IDIM .EQ. 2)THEN 706 : CALL CKON1(LOGME,INDMET, 707 : & IROF,IVITF,IPF,IGAMF,IFRMAF, 708 : & ICHPSU,ICHPDI, 709 : & MELEMC,MELEMF,MELEFE, 710 : & IZG1,IZG2,IZG3,IZG4,DT,DIAMEL,NLCEMI, 711 : & LOGNC,LOGAN,MESERR) 712 : ELSE 712 : CALL CKON2(LOGME,INDMET, 713 : & IROF,IVITF,IPF,IGAMF,IFRMAF, 714 : & ICHPSU,ICHPDI, 715 : & MELEMC,MELEMF,MELEFE, 716 : & IZG1,IZG2,IZG3,IZG4,DT,DIAMEL,NLCEMI, 717 : & LOGNC,LOGAN,MESERR) 718 : ENDIF 719 : C 720 : IF(LOGAN)THEN 721 : C 722 : C******* Anomalie detectée 723 : C 724 : C 725 : C******* Message d'erreur standard 726 : C -301 0 727 : C %m1:40 728 : C 729 : MOTERR(1:40) = MESERR(1:40) 729 : CALL ERREUR(-301) 730 : C 731 : C******* Message d'erreur standard 732 : C 5 3 733 : C Erreur anormale.contactez votre support 734 : C 734 : CALL ERREUR(5) 735 : GOTO 9999 736 : ENDIF 737 : IF(LOGNC)THEN 738 : C 739 : C******* Message d'erreur standard 740 : C -301 0 741 : C %m1:40 742 : C 743 : MOTERR(1:40) = MESERR(1:40) 743 : CALL ERREUR(-301) 744 : C 745 : C******* Message d'erreur standard 746 : C 460 2 747 : C Pas de convergence dans les itérations internes 748 : C 748 : CALL ERREUR(460) 749 : GOTO 9999 750 : ENDIF 751 : C 752 : C**** Ecriture des RESULTATS 753 : C 754 : TYPE = 'TABLE ' 754 : CALL ACMO(IEQEX,'PASDETPS',TYPE,MTABT) 755 : IF(IERR .NE. 0) GOTO 9999 756 : IF(TYPE .NE. 'TABLE ')THEN 757 : MOTERR(1:40) = 'EULER, subroutine ckon.eso, PASDETPS = ?' 758 : C 759 : C******* Message d'erreur standard 760 : C -301 0 %m1:40 761 : C 761 : CALL ERREUR(-301) 762 : C 763 : C******* Message d'erreur standard 764 : C 5 3 765 : C Erreur anormale.contactez votre support 766 : C 766 : CALL ERREUR(5) 767 : GO TO 9999 768 : ENDIF 769 : C 770 : C******* On remplie la table d'indice PASDETPS 771 : C 771 : CALL ECMF(MTABT,'DELTAT',DT) 771 : CALL ECMM(MTABT,'OPER','KONV') 771 : CALL ECMM(MTABT,'ZONE',NOMZ) 771 : CALL ECMF(MTABT,'DTCONV',DT) 771 : CALL ECMF(MTABT,'DTDIFU',1.0D50) 771 : CALL ECMF(MTABT,'DIAEL',DIAMEL) 771 : CALL ECME(MTABT,'NUEL',NLCEMI) 772 : C 773 : C**** Ecriture des CHPOINTs increments dans la table KIZG 774 : C déjà faite 775 : C 776 : SEGDES MLMOT1 777 : C 778 : ELSE 779 : C******************************************************************* 780 : C******************************************************************* 781 : C******************* GAZ THERMALLY PERFECT ************************* 782 : C******************************************************************* 783 : C******************************************************************* 784 : C 785 : C***************************** 786 : C******* Metode utilisée ***** 787 : C***************************** 788 : C 789 : C******* Metode utilisée 790 : C 790 : CALL ACME(IKOPT,'IDCEN',IND) 791 : IF(IERR .NE. 0) GOTO 9999 792 : C 793 : C IND METHODE (voir EQEX) 794 : C 795 : C 9 GODUNOV 796 : C 10 VANLEER (Van Leer FVS) 797 : C 11 VLH (Van Leer-HANEL FVS) 798 : C 12 HUSVL (Van Leer FVS + Osher FDS)) 799 : C 13 HUSVLH (Van Leer-HANEL FVS + Osher FDS) 800 : C 14 AUSM (AUSM+, de Liou) 801 : C 15 CG (Colella-Glaz) 802 : C Pour l'instant van Leer - Hanel, Colella-Glaz 803 : C 804 : IF(IND .EQ. 11)THEN 805 : INDMET = 1 806 : ELSEIF(IND .EQ. 15)THEN 807 : INDMET = 2 808 : ELSE 809 : C 810 : C********** Message d'erreur standard 811 : C 251 2 812 : C Tentative d'utilisation d'une option non implémentée 813 : C 813 : CALL ERREUR(251) 814 : ENDIF 815 : C 816 : C******************************************************** 817 : C******* Lecture des arguments de KONV KIZX . 'ARG*'***** 818 : C******************************************************** 819 : C 820 : C 821 : C**** Lecture de la table qui contient le proprieté du gaz 822 : C Cette table est controlle par l'operateur PRIM 823 : C 824 : MOTLU=' ' 824 : CALL ACMM(KIZX,'ARG1 ',MOTLU) 825 : IF(IERR .NE. 0) GOTO 9999 826 : C 827 : TYPE='TABLE ' 827 : CALL ACMO(INCO,MOTLU,TYPE,IPGAZ) 828 : IF(IERR .NE. 0) GOTO 9999 829 : IF(TYPE .NE. 'TABLE ')THEN 830 : C 831 : C******* Message d'erreur standard 832 : C 37 2 833 : C On ne trouve pas d'objet de type %m1:8 834 : C 835 : MOTERR(1:8) = 'TABLE ' 835 : CALL ERREUR(37) 836 : GOTO 9999 837 : ENDIF 838 : C 839 : C******* Degree des polynoms cv(T) 840 : C 841 : MTYPI = 'MOT ' 842 : MTYPR = ' ' 842 : CALL ACCTAB(IPGAZ,MTYPI,IVALI,XVALI,'NORD',LOGII,IRETI, 843 : & MTYPR,NORD,XVALR,CHARR,LOGIR,IRETR) 844 : IF(MTYPR .NE. 'ENTIER ')THEN 845 : C 846 : C******* Message d'erreur standard 847 : C -301 0 %m1:40 848 : C 849 : MOTERR(1:40) = 'ARG1 . NORD = ??? ' 849 : CALL ERREUR(-301) 850 : C 851 : C******* Message d'erreur standard 852 : C 21 2 853 : C Données incompatibles 854 : C 854 : CALL ERREUR(21) 855 : GOTO 9999 856 : ENDIF 857 : NORDP1 = NORD + 1 858 : C 859 : C******* Nom de l'espece qui n'est pas dans les equations d'Euler 860 : C 861 : MTYPI = 'MOT ' 862 : MTYPR = ' ' 862 : CALL ACCTAB(IPGAZ,MTYPI,IVALI,XVALI,'ESPNEULE',LOGII,IRETI, 863 : & MTYPR,IVALR,XVALR,CHARR,LOGIR,IESP) 864 : IF(MTYPR .NE. 'MOT ')THEN 865 : C 866 : C******* Message d'erreur standard 867 : C -301 0 %m1:40 868 : C 869 : MOTERR(1:40) = 'ARG1 . ESPNEULE = ??? ' 869 : CALL ERREUR(-301) 870 : C 871 : C******* Message d'erreur standard 872 : C 21 2 873 : C Données incompatibles 874 : C 874 : CALL ERREUR(21) 875 : GOTO 9999 876 : ENDIF 877 : C 878 : C**** Les especes qui sont dans les Equations d'Euler 879 : C 880 : MTYPR = ' ' 880 : CALL ACMO(IPGAZ,'ESPEULE',MTYPR,MLMOEU) 881 : IF(MTYPR .EQ. ' ')THEN 882 : NESP = 0 883 : IFRMAF = 0 884 : JGN = 4 885 : JGM = 1 886 : SEGINI MLMOT2 887 : MLMOT2.MOTS(1) = CHARR(1:4) 888 : LOGME = .FALSE. 889 : ELSEIF(MTYPR .NE. 'LISTMOTS')THEN 890 : C 891 : C******* Message d'erreur standard 892 : C -301 0 %m1:40 893 : C 894 : MOTERR(1:40) = 'ARG1 . ESPEULE = ??? ' 894 : CALL ERREUR(-301) 895 : C 896 : C******* Message d'erreur standard 897 : C 21 2 898 : C Données incompatibles 899 : C 899 : CALL ERREUR(21) 900 : GOTO 9999 901 : ELSE 902 : LOGME = .TRUE. 903 : SEGACT MLMOEU 904 : NESP = MLMOEU.MOTS(/2) 905 : JGN = 4 906 : JGM = NESP + 1 907 : SEGINI MLMOT2 908 : DO I1 = 1, NESP 909 : MLMOT2.MOTS(I1) = MLMOEU.MOTS(I1) 910 : ENDDO 911 : MLMOT2.MOTS(NESP+1)=CHARR(1:4) 912 : ENDIF 913 : C 914 : C**** Les scalaires passifs 915 : C 916 : MTYPR = ' ' 916 : CALL ACMO(IPGAZ,'SCALPASS',MTYPR,MLMOSC) 917 : IF(MTYPR .EQ. ' ')THEN 918 : LOGSCA = .FALSE. 919 : NSCA = 0 920 : ISCAF = 0 921 : ELSEIF(MTYPR .NE. 'LISTMOTS')THEN 922 : C 923 : C******* Message d'erreur standard 924 : C -301 0 %m1:40 925 : C 926 : MOTERR(1:40) = 'ARG1 . SCALPASS = ??? ' 926 : CALL ERREUR(-301) 927 : C 928 : C******* Message d'erreur standard 929 : C 21 2 930 : C Données incompatibles 931 : C 931 : CALL ERREUR(21) 932 : GOTO 9999 933 : ELSE 934 : LOGSCA = .TRUE. 935 : SEGACT MLMOSC 936 : NSCA = MLMOSC.MOTS(/2) 937 : ENDIF 938 : C 939 : C**** On rempli les segment PROPHY 940 : C Ordre: IPGAZ . 'ESPEULE' + IPGAZ . 'ESPNEULE' 941 : C On controlle aussi la compatibilite des 942 : C donnes de la table 943 : C 944 : SEGINI PROPHY 945 : C 946 : C**** N.B. NOMTOT est un CHARACTER*(4) 947 : C 948 : DO I1 = 1, NESP+1 949 : NOMTOT(1) = MLMOT2.MOTS(I1) 950 : C 950 : C******* CALL ACMF(...) ne marche pas parce que on a 951 : C des blanches dans nos composantes 952 : C 953 : MTYPI = 'MOT ' 954 : MTYPR = ' ' 954 : CALL ACCTAB(IPGAZ,MTYPI,IVALI,XVALI,NOMTOT(1), LOGII,IRETI, 955 : & MTYPR,IVALR,XVALR,CHARR,LOGIR,IESP) 956 : C 957 : C******* En IESP a la table IPGAZ.NOMTOT(1) 958 : C 959 : IF((IERR .NE. 0) .OR. (MTYPR .NE. 'TABLE ')) THEN 960 : 961 : C 962 : C********** Message d'erreur standard 963 : C -301 0 %m1:40 964 : C 965 : MOTERR = ' ' 966 : MOTERR(1:7) = 'ARG1 . ' 967 : MOTERR(8:11) = NOMTOT(1) 968 : MOTERR(13:17) = '= ???' 968 : CALL ERREUR(-301) 969 : C 970 : C********** Message d'erreur standard 971 : C 21 2 972 : C Données incompatibles 973 : C 973 : CALL ERREUR(21) 974 : GOTO 9999 975 : ENDIF 976 : C 977 : C******* R 978 : C 979 : MTYPI = 'MOT ' 980 : MTYPR = ' ' 980 : CALL ACCTAB(IESP,MTYPI,IVALI,XVALI, 'R' , LOGII,IRETI, 981 : & MTYPR,IVALR, XVALR ,CHARR,LOGIR,IRETR) 982 : IF((IERR .NE. 0) .OR. (MTYPR .NE. 'FLOTTANT')) THEN 983 : 984 : C 985 : C********** Message d'erreur standard 986 : C -301 0 %m1:40 987 : C 988 : MOTERR = ' ' 989 : MOTERR(1:7) = 'ARG1 . ' 990 : MOTERR(8:11) = NOMTOT(1) 991 : MOTERR(13:23) = ' . R = ??? ' 991 : CALL ERREUR(-301) 992 : C 993 : C********** Message d'erreur standard 994 : C 21 2 995 : C Données incompatibles 996 : C 996 : CALL ERREUR(21) 997 : GOTO 9999 998 : ENDIF 999 : PROPHY.R(I1)=XVALR 1000 : C 1001 : C******* H0K 1002 : C 1003 : MTYPI = 'MOT ' 1004 : MTYPR = ' ' 1004 : CALL ACCTAB(IESP,MTYPI,IVALI,XVALI, 'H0K' , LOGII,IRETI, 1005 : & MTYPR,IVALR, XVALR ,CHARR,LOGIR,IRETR) 1006 : IF((IERR .NE. 0) .OR. (MTYPR .NE. 'FLOTTANT')) THEN 1007 : 1008 : C 1009 : C********** Message d'erreur standard 1010 : C -301 0 %m1:40 1011 : C 1012 : MOTERR = ' ' 1013 : MOTERR(1:7) = 'ARG1 . ' 1014 : MOTERR(8:11) = NOMTOT(1) 1015 : MOTERR(13:25) = ' . H0K = ??? ' 1015 : CALL ERREUR(-301) 1016 : C 1017 : C********** Message d'erreur standard 1018 : C 21 2 1019 : C Données incompatibles 1020 : C 1020 : CALL ERREUR(21) 1021 : GOTO 9999 1022 : ENDIF 1023 : PROPHY.H0K(I1)=XVALR 1024 : C 1025 : C******* A 1026 : C 1027 : MTYPI = 'MOT ' 1028 : MTYPR = ' ' 1028 : CALL ACCTAB(IESP,MTYPI,IVALI,XVALI, 'A' , LOGII,IRETI, 1029 : & MTYPR,IVALR, XVALR ,CHARR,LOGIR,IRETR) 1030 : IF((IERR .NE. 0) .OR. (MTYPR .NE. 'LISTREEL')) THEN 1031 : 1032 : C 1033 : C********** Message d'erreur standard 1034 : C -301 0 %m1:40 1035 : C 1036 : MOTERR = ' ' 1037 : MOTERR(1:7) = 'ARG1 . ' 1038 : MOTERR(8:11) = NOMTOT(1) 1039 : MOTERR(13:23) = ' . A = ??? ' 1039 : CALL ERREUR(-301) 1040 : C 1041 : C********** Message d'erreur standard 1042 : C 21 2 1043 : C Données incompatibles 1044 : C 1044 : CALL ERREUR(21) 1045 : GOTO 9999 1046 : ENDIF 1047 : MLREEL = IRETR 1048 : SEGACT MLREEL 1049 : C 1050 : C******* Dans le calcul, c'est plus utile ACV dans la forme 1051 : C ACV(,exponente,espece) 1052 : C 1053 : DO I2 = 1, NORDP1 1054 : PROPHY.ACV(I2,I1)= MLREEL.PROG(I2) 1055 : ENDDO 1056 : SEGDES MLREEL 1057 : ENDDO 1058 : SEGSUP MLMOT2 1059 : C 1060 : C**** La table IPGAZ donc a ete controllee et PROPHY est rempli 1061 : C 1062 : C 1063 : C**** Lecture du MCHAML 'FACEL' contenant la masse volumique. 1064 : C 1065 : C D'abord on va lire son nom in KIZX . 'ARG1 ' -> MOTLU 1066 : C 1067 : MOTLU=' ' 1067 : CALL ACMM(KIZX,'ARG2 ',MOTLU) 1068 : IF(IERR.NE.0) GOTO 9999 1069 : C 1070 : C**** On va lire le pointeur du MCHAML 1071 : C 1072 : TYPE='MCHAML ' 1072 : CALL ACMO(INCO,MOTLU,TYPE,IROF) 1073 : IF(IERR.NE.0) GOTO 9999 1074 : IF(TYPE .NE. 'MCHAML ')THEN 1075 : C 1076 : C******* Message d'erreur standard 1077 : C 37 2 1078 : C On ne trouve pas d'objet de type %m1:8 1079 : C 1080 : MOTERR(1:8) = 'MCHAML ' 1080 : CALL ERREUR(37) 1081 : GOTO 9999 1082 : ENDIF 1083 : C 1084 : C**** Lecture du MCHAML 'FACEL' vitesse 1085 : C 1086 : MOTLU=' ' 1086 : CALL ACMM(KIZX,'ARG3 ',MOTLU) 1087 : IF(IERR.NE.0)GOTO 9999 1088 : C 1089 : TYPE='MCHAML ' 1089 : CALL ACMO(INCO,MOTLU,TYPE,IVITF) 1090 : IF(IERR .NE. 0) GOTO 9999 1091 : IF(TYPE .NE. 'MCHAML ')THEN 1092 : C 1093 : C******* Message d'erreur standard 1094 : C 37 2 1095 : C On ne trouve pas d'objet de type %m1:8 1096 : C 1097 : MOTERR(1:8) = 'MCHAML ' 1097 : CALL ERREUR(37) 1098 : GOTO 9999 1099 : ENDIF 1100 : C 1101 : C***** Lecture du MCHAML 'FACEL' contenant la temperature 1102 : C 1103 : MOTLU=' ' 1103 : CALL ACMM(KIZX,'ARG4 ',MOTLU) 1104 : IF(IERR .NE. 0) GOTO 9999 1105 : C 1106 : TYPE='MCHAML ' 1106 : CALL ACMO(INCO,MOTLU,TYPE,IPF) 1107 : IF(IERR .NE. 0) GOTO 9999 1108 : IF(TYPE .NE. 'MCHAML ')THEN 1109 : C 1110 : C******* Message d'erreur standard 1111 : C 37 2 1112 : C On ne trouve pas d'objet de type %m1:8 1113 : C 1114 : MOTERR(1:8) = 'MCHAML ' 1114 : CALL ERREUR(37) 1115 : GOTO 9999 1116 : ENDIF 1117 : C 1118 : C 1119 : C**** Multi-especes (LOGME = .TRUE.) 1120 : C Scalaires à transporter (LOGSCA = .TRUE.) 1121 : C 1122 : C 1123 : IF(LOGME .AND. LOGSCA)THEN 1124 : C 1125 : C********** On controle si KIZX . 'ARG5' et KIZX . 'ARG6' existent 1126 : C 1127 : TYPE = ' ' 1128 : MOTLU=' ' 1128 : CALL ACCTAB(KIZX,'MOT',0,0.D0,'ARG5', .TRUE.,0, 1129 : & TYPE,IENT,XVAL,MOTLU,XLOGI,IRET) 1130 : IF(TYPE .EQ. 'MOT')THEN 1131 : C 1132 : C************* Lecture du MCHAML 'FACEL' contenant les fractiones massiques 1133 : C 1134 : C 1135 : TYPE='MCHAML ' 1135 : CALL ACMO(INCO,MOTLU,TYPE,IFRMAF) 1136 : IF(IERR .NE. 0) GOTO 9999 1137 : IF(TYPE .NE. 'MCHAML ')THEN 1138 : C 1139 : C************* Message d'erreur standard 1140 : C 37 2 1141 : C On ne trouve pas d'objet de type %m1:8 1142 : C 1143 : MOTERR(1:8) = 'MCHAML ' 1143 : CALL ERREUR(37) 1144 : GOTO 9999 1145 : ENDIF 1146 : ELSE 1147 : C 1148 : C********** Message d'erreur standard 1149 : C 21 2 1150 : C Données incompatibles 1151 : C 1151 : CALL ERREUR(21) 1152 : GO TO 9999 1153 : ENDIF 1154 : C 1155 : TYPE = ' ' 1156 : MOTLU=' ' 1156 : CALL ACCTAB(KIZX,'MOT',0,0.D0,'ARG6', .TRUE.,0, 1157 : & TYPE,IENT,XVAL,MOTLU,XLOGI,IRET) 1158 : IF(TYPE .EQ. 'MOT')THEN 1159 : C 1160 : C************* Lecture du MCHAML 'FACEL' contenant les fractiones massiques 1161 : C 1162 : C 1163 : TYPE='MCHAML ' 1163 : CALL ACMO(INCO,MOTLU,TYPE,ISCAF) 1164 : IF(IERR .NE. 0) GOTO 9999 1165 : IF(TYPE .NE. 'MCHAML ')THEN 1166 : C 1167 : C************* Message d'erreur standard 1168 : C 37 2 1169 : C On ne trouve pas d'objet de type %m1:8 1170 : C 1171 : MOTERR(1:8) = 'MCHAML ' 1171 : CALL ERREUR(37) 1172 : GOTO 9999 1173 : ENDIF 1174 : ELSE 1175 : C 1176 : C********** Message d'erreur standard 1177 : C 21 2 1178 : C Données incompatibles 1179 : C 1179 : CALL ERREUR(21) 1180 : GO TO 9999 1181 : ENDIF 1182 : C 1183 : ELSEIF(LOGME)THEN 1184 : C 1185 : C********** On controle si KIZX . 'ARG5' existe 1186 : C 1187 : TYPE = ' ' 1188 : MOTLU=' ' 1188 : CALL ACCTAB(KIZX,'MOT',0,0.D0,'ARG5', .TRUE.,0, 1189 : & TYPE,IENT,XVAL,MOTLU,XLOGI,IRET) 1190 : IF(TYPE .EQ. 'MOT')THEN 1191 : C 1192 : C************* Lecture du MCHAML 'FACEL' contenant les fractiones massiques 1193 : C 1194 : C 1195 : TYPE='MCHAML ' 1195 : CALL ACMO(INCO,MOTLU,TYPE,IFRMAF) 1196 : IF(IERR .NE. 0) GOTO 9999 1197 : IF(TYPE .NE. 'MCHAML ')THEN 1198 : C 1199 : C************* Message d'erreur standard 1200 : C 37 2 1201 : C On ne trouve pas d'objet de type %m1:8 1202 : C 1203 : MOTERR(1:8) = 'MCHAML ' 1203 : CALL ERREUR(37) 1204 : GOTO 9999 1205 : ENDIF 1206 : ELSE 1207 : C 1208 : C********** Message d'erreur standard 1209 : C 21 2 1210 : C Données incompatibles 1211 : C 1211 : CALL ERREUR(21) 1212 : GO TO 9999 1213 : ENDIF 1214 : ELSEIF(LOGSCA)THEN 1215 : C 1216 : C********** On controle si KIZX . 'ARG5' existe 1217 : C 1218 : TYPE = ' ' 1219 : MOTLU=' ' 1219 : CALL ACCTAB(KIZX,'MOT',0,0.D0,'ARG5', .TRUE.,0, 1220 : & TYPE,IENT,XVAL,MOTLU,XLOGI,IRET) 1221 : IF(TYPE .EQ. 'MOT')THEN 1222 : C 1223 : C************* Lecture du MCHAML 'FACEL' contenant les fractiones massiques 1224 : C 1225 : TYPE='MCHAML ' 1225 : CALL ACMO(INCO,MOTLU,TYPE,ISCAF) 1226 : IF(IERR .NE. 0) GOTO 9999 1227 : IF(TYPE .NE. 'MCHAML ')THEN 1228 : C 1229 : C************* Message d'erreur standard 1230 : C 37 2 1231 : C On ne trouve pas d'objet de type %m1:8 1232 : C 1233 : MOTERR(1:8) = 'MCHAML ' 1233 : CALL ERREUR(37) 1234 : GOTO 9999 1235 : ENDIF 1236 : ELSE 1237 : C 1238 : C********** Message d'erreur standard 1239 : C 21 2 1240 : C Données incompatibles 1241 : C 1241 : CALL ERREUR(21) 1242 : GO TO 9999 1243 : ENDIF 1244 : ENDIF 1245 : C 1246 : C******* Lecture de Nom des Inconnues de KONV (KIZX . 'LISTINCO') 1247 : C 1248 : TYPE='LISTMOTS' 1248 : CALL ACMO(KIZX,'LISTINCO',TYPE,LINCO) 1249 : MLMOT1 = LINCO 1250 : IF(IERR.NE.0)GOTO 9999 1251 : SEGACT MLMOT1 1252 : C 1253 : C******* Verification du Nombre d'inconnues. 1254 : C 1255 : C Eulero mono-espece (+ scalaires passifs) -> NBRINC = 3 (+1) 1256 : C Eulero multi-especies (+ scalaires passifs) -> NBRINC = 4 (+1) 1257 : C 1258 : NBRINC = MLMOT1.MOTS(/2) 1259 : NCELL = 3 1260 : IF(LOGME) NCELL = NCELL + 1 1261 : IF(LOGSCA) NCELL = NCELL + 1 1262 : IF(NBRINC .NE. NCELL)THEN 1263 : C 1264 : C********** Message d'erreur standard 1265 : C -301 0 %m1:40 1266 : C 1267 : MOTERR(1:40) ='EULERMST: LISTINCO = ? ' 1267 : CALL ERREUR(-301) 1268 : C 1269 : C*********** Message d'erreur standard 1270 : C 21 2 Données incompatibles 1271 : C 1271 : CALL ERREUR(21) 1272 : GO TO 9999 1273 : ENDIF 1274 : C 1275 : C******* Table DOMAINE en IDOMA (pointeur de la zone de KONV) 1276 : C 1277 : C 1278 : C******* Lecture du MELEME SPG des points CENTRE. 1279 : C 1280 : C 1280 : C CALL LEKTAB(IDOMA,'CENTRE',MELEMC) 1281 : C 1282 : C******* Probleme du LEKTAB: si IDOMA.'CENTRE' n'existe pas, 1283 : C il crèe IDOMA.'CENTRE' sans recrèer 'FACEL' 1284 : C -> la correspondance global des noeuds saut! 1285 : C 1286 : C On peut utilizer ACCTAB ou ACMO 1287 : C 1288 : TYPE = 'MAILLAGE' 1288 : CALL ACMO(IDOMA,'CENTRE',TYPE,MELEMC) 1289 : IF(IERR .NE. 0) GOTO 9999 1290 : IF(TYPE .NE. 'MAILLAGE')THEN 1291 : MOTERR(1:8) = NOMZ 1292 : MOTERR(9:40) = ' . CENTRE = ? ' 1293 : C 1294 : C********** Message d'erreur standard 1295 : C -301 0 %m1:40 1296 : C 1296 : CALL ERREUR(-301) 1297 : C 1298 : C********** Message d'erreur standard 1299 : C 21 2 1300 : C Données incompatibles 1301 : C 1301 : CALL ERREUR(21) 1302 : GO TO 9999 1303 : ENDIF 1304 : C 1305 : C******* Lecture du MELEME 'FACE' SPG des points FACE 1306 : C 1306 : CALL ACMO(IDOMA,'FACE',TYPE,MELEMF) 1307 : IF(IERR .NE. 0) GOTO 9999 1308 : IF(TYPE .NE. 'MAILLAGE')THEN 1309 : MOTERR(1:8) = NOMZ 1310 : MOTERR(9:40) = ' . FACE = ? ' 1311 : C 1312 : C********** Message d'erreur standard 1313 : C -301 0 %m1:40 1314 : C 1314 : CALL ERREUR(-301) 1315 : C 1316 : C********** Message d'erreur standard 1317 : C 21 2 1318 : C Données incompatibles 1319 : C 1319 : CALL ERREUR(21) 1320 : GO TO 9999 1321 : ENDIF 1322 : C 1323 : C******* Lecture du MELEME 'FACEL' de connect. FACE -> CENTRE 1324 : C 1324 : CALL ACMO(IDOMA,'FACEL',TYPE,MELEFE) 1325 : IF(IERR .NE. 0) GOTO 9999 1326 : IF(TYPE .NE. 'MAILLAGE')THEN 1327 : MOTERR(1:8) = NOMZ 1328 : MOTERR(9:40) = ' . FACEL = ? ' 1329 : C 1330 : C******* Message d'erreur standard 1331 : C -301 0 %m1:40 1332 : C 1332 : CALL ERREUR(-301) 1333 : C 1334 : C******* Message d'erreur standard 1335 : C 21 2 1336 : C Données incompatibles 1337 : C 1337 : CALL ERREUR(21) 1338 : GO TO 9999 1339 : ENDIF 1340 : C 1341 : C**** Lecture du CHPOINT contenant les surfaces des faces. 1342 : C 1342 : CALL LEKTAB(IDOMA,'XXSURFAC',ICHPSU) 1343 : IF(IERR .NE. 0) GOTO 9999 1344 : C 1345 : C**** Lecture du CHPOINT contenant les diametres minimums. 1346 : C 1346 : CALL LEKTAB(IDOMA,'XXDIEMIN',ICHPDI) 1347 : IF(IERR .NE. 0) GOTO 9999 1348 : C 1349 : C 1350 : C**** Lecture de la TABLE contenant les FLUX aux interfaces, 1351 : C i.e. KIZX . 'EQEX' . 'KIZG' 1352 : C 1353 : C N.B. On recuper le pointeur des flux relatives aux 1354 : C inconnues de KONV. 1355 : C 1356 : TYPE= ' ' 1356 : CALL ACMO(IEQEX,'KIZG',TYPE,KIZG) 1357 : IF(IERR .NE. 0) GOTO 9999 1358 : IF(TYPE .NE. 'TABLE ')THEN 1358 : CALL CRTABL(KIZG) 1358 : CALL ECMM(KIZG,'SOUSTYPE','KIZG') 1358 : CALL ECMO(IEQEX,'KIZG','TABLE ',KIZG) 1359 : ENDIF 1360 : C 1361 : C**** Creation des CHPOINTs increment IZG1-2-3-4 pour les FLUX 1362 : C ou extraction des leurs pointeurs 1363 : C 1364 : C 1365 : C**** La masse volumique 1366 : C 1367 : C 1368 : TYPE=' ' 1369 : ARG = MLMOT1.MOTS(1) 1369 : CALL ACMO(KIZG,ARG,TYPE,IZG1) 1370 : IF(IERR .NE. 0) GOTO 9999 1371 : IF(TYPE .NE. 'CHPOINT ')THEN 1372 : TYPE = 'FACE' 1373 : NBCOMP = 1 1373 : CALL CRCHPT(TYPE,MELEMF,NBCOMP,IZG1) 1374 : IF(IERR .NE. 0)GOTO 9999 1375 : C 1376 : C******* Stokage du pointeur dans KIZG 1377 : C 1378 : ARG = MLMOT1.MOTS(1) 1378 : CALL ECMO(KIZG,ARG,'CHPOINT ',IZG1) 1379 : ELSE 1380 : INDIC = 1 1381 : NBCOMP = 1 1382 : NOMTOT(1) = ' ' 1382 : CALL QUEPOI(IZG1,MELEMF,INDIC,NBCOMP,NOMTOT) 1383 : IF(IERR .NE. 0)GOTO 9999 1384 : ENDIF 1385 : C 1386 : C**** Les debits 1387 : C 1388 : TYPE=' ' 1389 : ARG = MLMOT1.MOTS(2) 1389 : CALL ACMO(KIZG,ARG,TYPE,IZG2) 1390 : IF(IERR .NE. 0) GOTO 9999 1391 : IF(TYPE .NE. 'CHPOINT ')THEN 1392 : TYPE='FACE' 1393 : NBCOMP = IDIM 1393 : CALL CRCHPT(TYPE,MELEMF,NBCOMP,IZG2) 1394 : IF(IERR .NE. 0) GOTO 9999 1395 : C 1396 : C******* Stokage du pointeur dans KIZG 1397 : C 1398 : ARG = MLMOT1.MOTS(2) 1398 : CALL ECMO(KIZG,ARG,'CHPOINT ',IZG2) 1399 : ELSE 1400 : INDIC = 1 1401 : NBCOMP = IDIM 1402 : NOMTOT(1) = ' ' 1402 : CALL QUEPOI(IZG2,MELEMF,INDIC,NBCOMP,NOMTOT) 1403 : IF(IERR .NE. 0)GOTO 9999 1404 : ENDIF 1405 : C 1406 : C**** L'energie totale volumique 1407 : C 1408 : TYPE=' ' 1409 : ARG = MLMOT1.MOTS(3) 1409 : CALL ACMO(KIZG,ARG,TYPE,IZG3) 1410 : IF(IERR .NE. 0) GOTO 9999 1411 : IF(TYPE .NE. 'CHPOINT ')THEN 1412 : TYPE='FACE' 1413 : NBCOMP = 1 1413 : CALL CRCHPT(TYPE,MELEMF,NBCOMP,IZG3) 1414 : IF(IERR .NE. 0) GOTO 9999 1415 : C 1416 : C******* Stokage du pointeur dans KIZG 1417 : C 1418 : ARG = MLMOT1.MOTS(3) 1418 : CALL ECMO(KIZG,ARG,'CHPOINT ',IZG3) 1419 : ELSE 1420 : INDIC = 1 1421 : NBCOMP = 1 1422 : NOMTOT(1) = ' ' 1422 : CALL QUEPOI(IZG3,MELEMF,INDIC,NBCOMP,NOMTOT) 1423 : IF(IERR .NE. 0)GOTO 9999 1424 : ENDIF 1425 : C 1426 : C**** Les Masses Volumiques et les (scalaires passifs * \rho) 1427 : C 1428 : IF(LOGME .AND. LOGSCA)THEN 1429 : C 1430 : C********** Masses volumiques 1431 : C 1432 : TYPE=' ' 1433 : ARG = MLMOT1.MOTS(4) 1433 : CALL ACMO(KIZG,ARG,TYPE,IZG4) 1434 : IF(IERR .NE. 0) GOTO 9999 1435 : IF(TYPE .NE. 'CHPOINT ')THEN 1436 : NBCOMP = NESP 1437 : TYPE='FACE ' 1438 : C 1439 : C********** On cree le chpoint FACE 1440 : C 1441 : IPT1 = MELEMF 1442 : SEGACT IPT1 1443 : N=IPT1.NUM(/2) 1444 : SEGDES IPT1 1445 : NSOUPO=1 1446 : NAT=1 1447 : NC = NESP 1448 : SEGINI, MCHPOI,MSOUPO,MPOVAL 1449 : MCHPOI.JATTRI(1)=2 1450 : MCHPOI.IFOPOI=IFOMOD 1451 : MCHPOI.MTYPOI=TYPE 1452 : MCHPOI.MOCHDE(1:30)=' ' 1453 : MCHPOI.MOCHDE(31:60)=' ' 1454 : MCHPOI.MOCHDE(61:72)=' ' 1455 : MCHPOI.IPCHP(1)=MSOUPO 1456 : SEGDES MCHPOI 1457 : MSOUPO.IGEOC=MELEMF 1458 : MSOUPO.IPOVAL=MPOVAL 1459 : DO I1 = 1, NC 1460 : MSOUPO.NOCOMP(I1) = MLMOEU.MOTS(I1) 1461 : ENDDO 1462 : SEGDES, MSOUPO,MPOVAL 1463 : IZG4 = MCHPOI 1464 : C 1465 : C********** Stokage du pointeur dans KIZG 1466 : C 1467 : ARG = MLMOT1.MOTS(4) 1467 : CALL ECMO(KIZG,ARG,'CHPOINT ',IZG4) 1468 : ELSE 1469 : INDIC = 1 1470 : NBCOMP = NESP 1471 : NOMTOT(1) = ' ' 1471 : CALL QUEPOI(IZG4,MELEMF,INDIC,NBCOMP,NOMTOT) 1472 : IF(IERR .NE. 0)GOTO 9999 1473 : ENDIF 1474 : C 1475 : C********** Les scalaires passifs 1476 : C 1477 : TYPE=' ' 1478 : ARG = MLMOT1.MOTS(5) 1478 : CALL ACMO(KIZG,ARG,TYPE,IZG5) 1479 : IF(IERR .NE. 0) GOTO 9999 1480 : IF(TYPE .NE. 'CHPOINT ')THEN 1481 : NBCOMP = NSCA 1482 : TYPE='FACE ' 1483 : C 1484 : C********** On cree le chpoint FACE 1485 : C 1486 : IPT1 = MELEMF 1487 : SEGACT IPT1 1488 : N=IPT1.NUM(/2) 1489 : SEGDES IPT1 1490 : NSOUPO=1 1491 : NAT=1 1492 : NC = NSCA 1493 : SEGINI, MCHPOI,MSOUPO,MPOVAL 1494 : MCHPOI.JATTRI(1)=2 1495 : MCHPOI.IFOPOI=IFOMOD 1496 : MCHPOI.MTYPOI=TYPE 1497 : MCHPOI.MOCHDE(1:30)=' ' 1498 : MCHPOI.MOCHDE(31:60)=' ' 1499 : MCHPOI.MOCHDE(61:72)=' ' 1500 : MCHPOI.IPCHP(1)=MSOUPO 1501 : SEGDES MCHPOI 1502 : MSOUPO.IGEOC=MELEMF 1503 : MSOUPO.IPOVAL=MPOVAL 1504 : DO I1 = 1, NC 1505 : MSOUPO.NOCOMP(I1) = MLMOSC.MOTS(I1) 1506 : ENDDO 1507 : SEGDES, MSOUPO,MPOVAL 1508 : IZG5 = MCHPOI 1509 : C 1510 : C********** Stokage du pointeur dans KIZG 1511 : C 1512 : ARG = MLMOT1.MOTS(5) 1512 : CALL ECMO(KIZG,ARG,'CHPOINT ',IZG5) 1513 : ELSE 1514 : INDIC = 1 1515 : NBCOMP = NSCA 1516 : NOMTOT(1) = ' ' 1516 : CALL QUEPOI(IZG5,MELEMF,INDIC,NBCOMP,NOMTOT) 1517 : IF(IERR .NE. 0)GOTO 9999 1518 : ENDIF 1519 : C 1520 : ELSEIF(LOGME)THEN 1521 : C 1522 : C********** Masses volumiques 1523 : C 1524 : TYPE=' ' 1525 : ARG = MLMOT1.MOTS(4) 1525 : CALL ACMO(KIZG,ARG,TYPE,IZG4) 1526 : IF(IERR .NE. 0) GOTO 9999 1527 : IF(TYPE .NE. 'CHPOINT ')THEN 1528 : NBCOMP = NESP 1529 : TYPE='FACE ' 1530 : C 1531 : C********** On cree le chpoint FACE 1532 : C 1533 : IPT1 = MELEMF 1534 : SEGACT IPT1 1535 : N=IPT1.NUM(/2) 1536 : SEGDES IPT1 1537 : NSOUPO=1 1538 : NAT=1 1539 : NC = NESP 1540 : SEGINI, MCHPOI,MSOUPO,MPOVAL 1541 : MCHPOI.JATTRI(1)=2 1542 : MCHPOI.IFOPOI=IFOMOD 1543 : MCHPOI.MTYPOI=TYPE 1544 : MCHPOI.MOCHDE(1:30)=' ' 1545 : MCHPOI.MOCHDE(31:60)=' ' 1546 : MCHPOI.MOCHDE(61:72)=' ' 1547 : MCHPOI.IPCHP(1)=MSOUPO 1548 : SEGDES MCHPOI 1549 : MSOUPO.IGEOC=MELEMF 1550 : MSOUPO.IPOVAL=MPOVAL 1551 : DO I1 = 1, NC 1552 : MSOUPO.NOCOMP(I1) = MLMOEU.MOTS(I1) 1553 : ENDDO 1554 : SEGDES, MSOUPO,MPOVAL 1555 : IZG4 = MCHPOI 1556 : C 1557 : C********** Stokage du pointeur dans KIZG 1558 : C 1559 : ARG = MLMOT1.MOTS(4) 1559 : CALL ECMO(KIZG,ARG,'CHPOINT ',IZG4) 1560 : ELSE 1561 : INDIC = 1 1562 : NBCOMP = NESP 1563 : NOMTOT(1) = ' ' 1563 : CALL QUEPOI(IZG4,MELEMF,INDIC,NBCOMP,NOMTOT) 1564 : IF(IERR .NE. 0)GOTO 9999 1565 : ENDIF 1566 : IZG5 = 0 1567 : ELSEIF(LOGSCA)THEN 1568 : C 1569 : C********** Masses volumiques 1570 : C 1571 : IZG4 = 0 1572 : TYPE=' ' 1573 : ARG = MLMOT1.MOTS(4) 1573 : CALL ACMO(KIZG,ARG,TYPE,IZG5) 1574 : IF(IERR .NE. 0) GOTO 9999 1575 : IF(TYPE .NE. 'CHPOINT ')THEN 1576 : NBCOMP = NSCA 1577 : TYPE='FACE ' 1578 : C 1579 : C********** On cree le chpoint FACE 1580 : C 1581 : IPT1 = MELEMF 1582 : SEGACT IPT1 1583 : N=IPT1.NUM(/2) 1584 : SEGDES IPT1 1585 : NSOUPO=1 1586 : NAT=1 1587 : NC = NSCA 1588 : SEGINI, MCHPOI,MSOUPO,MPOVAL 1589 : MCHPOI.JATTRI(1)=2 1590 : MCHPOI.IFOPOI=IFOMOD 1591 : MCHPOI.MTYPOI=TYPE 1592 : MCHPOI.MOCHDE(1:30)=' ' 1593 : MCHPOI.MOCHDE(31:60)=' ' 1594 : MCHPOI.MOCHDE(61:72)=' ' 1595 : MCHPOI.IPCHP(1)=MSOUPO 1596 : SEGDES MCHPOI 1597 : MSOUPO.IGEOC=MELEMF 1598 : MSOUPO.IPOVAL=MPOVAL 1599 : DO I1 = 1, NC 1600 : MSOUPO.NOCOMP(I1) = MLMOSC.MOTS(I1) 1601 : ENDDO 1602 : SEGDES, MSOUPO,MPOVAL 1603 : IZG5 = MCHPOI 1604 : C 1605 : C********** Stokage du pointeur dans KIZG 1606 : C 1607 : ARG = MLMOT1.MOTS(4) 1607 : CALL ECMO(KIZG,ARG,'CHPOINT ',IZG5) 1608 : ELSE 1609 : INDIC = 1 1610 : NBCOMP = NSCA 1611 : NOMTOT(1) = ' ' 1611 : CALL QUEPOI(IZG5,MELEMF,INDIC,NBCOMP,NOMTOT) 1612 : IF(IERR .NE. 0)GOTO 9999 1613 : ENDIF 1614 : ELSE 1615 : IZG4 = 0 1616 : IZG5 = 0 1617 : ENDIF 1618 : C 1619 : C**** Calcul des flux et du pas du temps. 1620 : C 1621 : IF( IDIM .EQ. 2)THEN 1622 : C 1623 : C 1624 : C***** 2D 1625 : C 1625 : CALL CKON3(LOGME,INDMET,NORDP1, 1626 : & IROF,IVITF,IPF,IFRMAF,ISCAF,PROPHY, 1627 : & ICHPSU,ICHPDI, 1628 : & MELEMC,MELEMF,MELEFE, 1629 : & IZG1,IZG2,IZG3,IZG4,IZG5,DT,DIAMEL,NLCEMI, 1630 : & LOGNC,LOGAN,MESERR) 1631 : ELSE 1632 : C 1633 : C 1634 : C***** 3D 1635 : C 1635 : CALL CKON4(LOGME,INDMET,NORDP1, 1636 : & IROF,IVITF,IPF,IFRMAF,ISCAF,PROPHY, 1637 : & ICHPSU,ICHPDI, 1638 : & MELEMC,MELEMF,MELEFE, 1639 : & IZG1,IZG2,IZG3,IZG4,IZG5,DT,DIAMEL,NLCEMI, 1640 : & LOGNC,LOGAN,MESERR) 1641 : ENDIF 1642 : C 1643 : IF(LOGAN)THEN 1644 : C 1645 : C******* Anomalie detectée 1646 : C 1647 : C 1648 : C******* Message d'erreur standard 1649 : C -301 0 1650 : C %m1:40 1651 : C 1652 : MOTERR(1:40) = MESERR(1:40) 1652 : CALL ERREUR(-301) 1653 : C 1654 : C******* Message d'erreur standard 1655 : C 5 3 1656 : C Erreur anormale.contactez votre support 1657 : C 1657 : CALL ERREUR(5) 1658 : GOTO 9999 1659 : ENDIF 1660 : IF(LOGNC)THEN 1661 : C 1662 : C******* Message d'erreur standard 1663 : C -301 0 1664 : C %m1:40 1665 : C 1666 : MOTERR(1:40) = MESERR(1:40) 1666 : CALL ERREUR(-301) 1667 : C 1668 : C******* Message d'erreur standard 1669 : C 460 2 1670 : C Pas de convergence dans les itérations internes 1671 : C 1671 : CALL ERREUR(460) 1672 : GOTO 9999 1673 : ENDIF 1674 : C 1675 : C**** Ecriture des RESULTATS 1676 : C 1677 : TYPE = 'TABLE ' 1677 : CALL ACMO(IEQEX,'PASDETPS',TYPE,MTABT) 1678 : IF(IERR .NE. 0) GOTO 9999 1679 : IF(TYPE .NE. 'TABLE ')THEN 1680 : MOTERR(1:40) = 'EULER, subroutine ckon.eso, PASDETPS = ?' 1681 : C 1682 : C******* Message d'erreur standard 1683 : C -301 0 %m1:40 1684 : C 1684 : CALL ERREUR(-301) 1685 : C 1686 : C******* Message d'erreur standard 1687 : C 5 3 1688 : C Erreur anormale.contactez votre support 1689 : C 1689 : CALL ERREUR(5) 1690 : GO TO 9999 1691 : ENDIF 1692 : C 1693 : C******* On remplie la table d'indice PASDETPS 1694 : C 1694 : CALL ECMF(MTABT,'DELTAT',DT) 1694 : CALL ECMM(MTABT,'OPER','KONV') 1694 : CALL ECMM(MTABT,'ZONE',NOMZ) 1694 : CALL ECMF(MTABT,'DTCONV',DT) 1694 : CALL ECMF(MTABT,'DTDIFU',1.0D50) 1694 : CALL ECMF(MTABT,'DIAEL',DIAMEL) 1694 : CALL ECME(MTABT,'NUEL',NLCEMI) 1695 : C 1696 : C**** Ecriture des CHPOINTs increments dans la table KIZG 1697 : C déjà faite 1698 : C 1699 : SEGDES MLMOT1 1700 : SEGSUP PROPHY 1701 : IF(LOGME) SEGDES MLMOEU 1702 : IF(LOGSCA) SEGDES MLMOSC 1703 : C 1704 : C 1705 : C 1706 : ENDIF 1707 : 9999 CONTINUE 1708 : RETURN 1709 : END 1710 : 1711 : 1712 : 1713 : 1714 : 1715 : 1716 : 1717 : 1718 : 1719 : 1720 : 1721 : 1722 :
© Cast3M 2003 - All rights reserved.
Disclaimer