1 : C KON19 SOURCE CHAT 06/08/24 21:47:59 5529 2 : SUBROUTINE KON19 3 : C************************************************************************ 4 : C 5 : C PROJET : CASTEM 2000 6 : C 7 : C NOM : KON19 8 : C 9 : C DESCRIPTION : Subroutine appellée par KON2 10 : C 11 : C Modelisation 2D/3D des equations d'Euler 12 : C MULTIESPECES!!!!!!!!!!!!!!! 13 : C 14 : C Calcul du jacobien 15 : C 16 : C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI) 17 : C 18 : C AUTEUR : S. KUDRIAKOV, DRN/DMT/SEMT/LTMF 19 : C 20 : C********************************************************************* 21 : C 21 : C APPELES (Calcul) : KONMSP (calcul du jacobien, gaz "calorically 22 : C perfect",multiespeces, 2D, AUSM+) 22 : C : KONMS3 (calcul du jacobien, gaz "calorically 23 : C perfect",multiespeces, 3D, AUSM+) 24 : C********************************************************************* 25 : C 26 : C*** SYNTAXE 27 : C 28 : C Discrétisation en VF "cell-centered" des équations d'Euler pour 29 : C un gaz parfait mono-constituent polytropique 30 : C Inconnues: densité, quantité de mouvement, énergie totale par 31 : C unité de volumes (variables conservatives) 32 : C 33 : C RMAT1 = 'KONV' 'VF' 'PERFMULT' 'JACOCONV' MOT3 TABD TABP LMOT1 34 : C (MAILIM) CHPO1 CHPO2 CHPO3 CHPO4 ; 35 : C----------------------- 36 : C ENTREES 37 : C----------------------- 38 : C MOT3 : objet de type MOT 39 : C 'AUSMPLUS' : jacobien du residu pour la methode AUSM+ 40 : C 41 : C TABD : la table domaine 42 : C 43 : C TABP : TABLE qui contient : 44 : C * les noms des especes qui apparessent 45 : C explicitement dans les equations d'Euler en 46 : C TABP . 'ESPEULE' (list de mots); 47 : C * le nom de l'espece qui n'y est pas (mots); 48 : C * les CP et les CV du gas en 49 : C TABP . 'CP' (table) 50 : C TABP . 'CV' (table) 51 : C 52 : C LMOT1 : objet de type LISTMOTS 53 : C Noms de composantes des variable primales et duales de RMAT1. 54 : C Il contient dans l'ordre suivant: le noms de la densité, 55 : C du momentum, de l'énergie totale et les fraction massiques 56 : C par unité de volume 57 : C 58 : C MAILIM : MAIILAGE de POI1 ou on ne veut pas calculer le FLUX 59 : C convective 60 : C 61 : C CHPO1 : CHPOINT contenant la masse volumique 62 : C (SPG = TAB1 . 'CENTRE', une seule composante, 63 : C 'SCAL'). 64 : C 65 : C CHPO2 : CHPOINT contenant la vitesse 66 : C (SPG = TAB1 . 'CENTRE', deux/trois composantes 67 : C 'UX', 'UY', 'UZ') 68 : C 69 : C CHPO3 : CHPOINT contenant la pression du gaz 70 : C (SPG = TAB1 . 'CENTRE', une seule composante, 71 : C 'SCAL'). 72 : C 73 : C CHPO4 : CHPOINT contenant les fraction massiques 74 : C des differentes especes 75 : C (SPG = TAB1 . 'CENTRE', nombre des composantes = NESP-1). 76 : C 77 : C--------------------- 78 : C SORTIES 79 : C--------------------- 80 : C RMAT1 : objet de type MATRIK 81 : C (SPG = TAB1 . 'CENTRE') 82 : C (inconnues primales = inconnues duales = LMOT1) 83 : C 84 : C************************************************************************ 85 : C 86 : C HISTORIQUE (Anomalies et modifications éventuelles) 87 : C 88 : C HISTORIQUE : 89 : C 90 : C************************************************************************ 91 : C 92 : IMPLICIT INTEGER(I-N) 93 : -INC CCOPTIO 94 : -INC SMLMOTS 95 : -INC SMCHPOI 96 : -INC SMELEME 97 : 98 : POINTEUR MLMVIT.MLMOTS 99 : C 100 : C**** Variables de COOPTIO 101 : C 102 : INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR 103 : & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ 104 : & ,IOPER, IOSGB, IOGRA, IOSAU, IORES 105 : & ,IECHO, IIMPI, IOSPI 106 : & ,IDIM, IFICLE, IPREFI 107 : & ,MCOORD 108 : & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE 109 : & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU 110 : & ,NORINC,NORVAL,NORIND,NORVAD 111 : & ,NUCROU, IPSAUV 112 : C 113 : INTEGER NBJAC, IRET, INDIC, NBCOMP, NESP, JGN, JGM 114 : & ,IDOMA, MELEMC, MELEMF, MELEFE, MELTFA, ICHPSU, ICHPDI 115 : & ,ICHPVO, INORM, ICP, MMODEL 116 : & ,IJACO, ILIINC, NC, IFLIM, MELLIM, ICACCA 117 : & ,IIMPL, IRN, IVN, IPN, IYN, IUINF, IUPRI 118 : & ,I1, JG, ICOND, IRETOU, ICV, INEFMD, IPGAS 119 : C 120 : PARAMETER (NBJAC=2) 121 : CHARACTER*8 TYPE, LJACO(NBJAC), MTYPR 122 : CHARACTER*4 MOT 123 : CHARACTER*(4) MOT1(3), CELLCH 124 : CHARACTER*(40) MESERR 125 : REAL*8 CP, CV 126 : C---------------------------------------------------- 127 : C************ Variables en ACCTAB ****************** 128 : C---------------------------------------------------- 129 : INTEGER IVALI, IRETI,IVALR, IRETR 130 : REAL*8 XVALI,XVALR 131 : LOGICAL LOGII, LOGIR 132 : CHARACTER*(8) CHARR,MTYPI 133 : DATA LJACO/'AUSMPLUS','AUSMPLM '/ 134 : cC---------------------------------------------------- 135 : cC************ Variables en ACCTAB ****************** 136 : cC---------------------------------------------------- 137 : c INTEGER IVALI, IRETI,IVALR, IRETR 138 : c REAL*8 XVALI,XVALR 139 : c LOGICAL LOGII, LOGIR 140 : c CHARACTER*(8) CHARR,MTYPI 141 : C---------------------------------------------------- 142 : -INC SMLREEL 143 : POINTEUR MLRECP.MLREEL, MLRECV.MLREEL 144 : C----------------------------------------- 145 : C Initialisation des variables en ACCTAB 146 : C----------------------------------------- 147 : IVALI = 0 148 : IVALR = 0 149 : XVALI = 0.0D0 150 : XVALR = 0.0D0 151 : LOGII = .FALSE. 152 : LOGIR = .FALSE. 153 : IRETI = 0 154 : IRETR = 0 155 : CHARR = ' ' 156 : C----------------------------- 157 : C**** Type of Jacobian 158 : C----------------------------- 158 : CALL LIRMOT(LJACO,NBJAC,IIMPL,1) 159 : IF(IERR .NE. 0)GOTO 9999 160 : C******************************* 161 : C**** La table domaine ********* 162 : C******************************* 163 : ICOND = 1 163 : CALL QUETYP(TYPE,ICOND,IRET) 164 : C 165 : IF(IRET.EQ.0.AND.TYPE.NE.'MMODEL')THEN 166 : WRITE(IOIMP,*)' On attend un objet MMODEL' 167 : GOTO 9999 168 : ENDIF 168 : CALL LIROBJ('MMODEL',MMODEL,ICOND,IRET) 169 : IF(IERR.NE.0)GOTO 9999 169 : CALL LEKMOD(MMODEL,IDOMA,INEFMD) 170 : C INEFMD inutilisé 171 : IF(IERR.NE.0)GOTO 9999 172 : C-------------------------------- 173 : C**** Centre, FACE, FACEL, ELTFA 174 : C-------------------------------- 174 : CALL LEKTAB(IDOMA,'CENTRE',MELEMC) 175 : IF(IERR .NE. 0) GOTO 9999 176 : C 176 : CALL LEKTAB(IDOMA,'FACE',MELEMF) 177 : IF(IERR .NE. 0) GOTO 9999 178 : C 178 : CALL LEKTAB(IDOMA,'FACEL',MELEFE) 179 : IF(IERR .NE. 0) GOTO 9999 180 : C 180 : CALL LEKTAB(IDOMA,'ELTFA',MELTFA) 181 : IF(IERR .NE. 0) GOTO 9999 182 : C--------------------------------------------------------- 183 : C**** Lecture du CHPOINT contenant les surfaces des faces. 184 : C--------------------------------------------------------- 184 : CALL LEKTAB(IDOMA,'XXSURFAC',ICHPSU) 185 : IF(IERR .NE. 0) GOTO 9999 186 : INDIC = 1 187 : NBCOMP = 1 188 : MOT = 'SCAL' 188 : CALL QUEPOI(ICHPSU, MELEMF, INDIC, NBCOMP, MOT) 189 : IF(IERR .NE. 0) GOTO 9999 190 : C--------------------------------------------------------- 191 : C**** Lecture du CHPOINT contenant les diametres minimums. 192 : C--------------------------------------------------------- 192 : CALL LEKTAB(IDOMA,'XXDIEMIN',ICHPDI) 193 : IF(IERR .NE. 0) GOTO 9999 194 : INDIC = 1 195 : NBCOMP = 1 196 : MOT = 'SCAL' 196 : CALL QUEPOI(ICHPDI, MELEMC, INDIC, NBCOMP, MOT) 197 : IF(IERR .NE. 0) GOTO 9999 198 : C---------------------------------------------- 199 : C**** Lecture du CHPOINT contenant les volumes 200 : C---------------------------------------------- 200 : CALL LEKTAB(IDOMA,'XXVOLUM',ICHPVO) 201 : IF(IERR .NE. 0) GOTO 9999 202 : INDIC = 1 203 : NBCOMP = 1 204 : MOT = 'SCAL' 204 : CALL QUEPOI(ICHPVO, MELEMC, INDIC, NBCOMP, MOT) 205 : IF(IERR .NE. 0) GOTO 9999 206 : C---------------------------- 207 : C**** Les normales aux faces 208 : C---------------------------- 209 : IF(IDIM .EQ. 2)THEN 210 : C Que les normales 210 : CALL LEKTAB(IDOMA,'XXNORMAF',INORM) 211 : IF(IERR .NE. 0) GOTO 9999 212 : JGN = 4 213 : JGM = 2 214 : SEGINI MLMVIT 215 : MLMVIT.MOTS(1) = 'UX ' 216 : MLMVIT.MOTS(2) = 'UY ' 216 : CALL QUEPO1(INORM, MELEMF, MLMVIT) 217 : SEGSUP MLMVIT 218 : IF(IERR .NE. 0) GOTO 9999 219 : ELSE 220 : C Les normales et les tangentes 221 : TYPE = ' ' 221 : CALL ACMO(IDOMA,'MATROT',TYPE,INORM) 222 : IF (TYPE .NE. 'CHPOINT ') THEN 222 : CALL MATRAN(IDOMA,INORM) 223 : IF(IERR .NE. 0) GOTO 9999 224 : ENDIF 225 : JGN = 4 226 : JGM = 9 227 : SEGINI MLMVIT 228 : MLMVIT.MOTS(1) = 'UX ' 229 : MLMVIT.MOTS(2) = 'UY ' 230 : MLMVIT.MOTS(3) = 'UZ ' 231 : MLMVIT.MOTS(4) = 'RX ' 232 : MLMVIT.MOTS(5) = 'RY ' 233 : MLMVIT.MOTS(6) = 'RZ ' 234 : MLMVIT.MOTS(7) = 'MX ' 235 : MLMVIT.MOTS(8) = 'MY ' 236 : MLMVIT.MOTS(9) = 'MZ ' 236 : CALL QUEPO1(INORM, MELEMF, MLMVIT) 237 : SEGSUP MLMVIT 238 : ENDIF 239 : C******************************** 240 : C**** Fin table domaine ********* 241 : C******************************** 242 : ICOND = 1 242 : CALL QUETYP(MTYPR,ICOND,IRETOU) 243 : IF(IERR .NE. 0)GOTO 9999 244 : IF(MTYPR .NE. 'TABLE ')THEN 245 : C--------------------------------------- 246 : C Message d'erreur standard 247 : C 37 2 248 : C On ne trouve pas d'objet de type %m1:8 249 : C--------------------------------------- 250 : MOTERR(1:8) = 'TABLE ' 250 : CALL ERREUR(37) 251 : GOTO 9999 252 : ELSE 253 : ICOND = 1 253 : CALL LIROBJ(MTYPR,IPGAS,ICOND,IRETOU) 254 : IF(IERR .NE. 0)GOTO 9999 255 : ENDIF 256 : C------------------------------------------- 257 : C******** Reading the CPs ***************** 258 : C------------------------------------------- 259 : MTYPR = ' ' 259 : CALL ACMO(IPGAS,'CP',MTYPR,ICP) 260 : IF(MTYPR .NE. 'TABLE ')THEN 261 : C-------------------------------- 262 : C Message d'erreur standard 263 : C -301 0 %m1:40 264 : C-------------------------------- 265 : MOTERR(1:40) = 'TAB1 . CP = ??? ' 266 : WRITE(IOIMP,*) MOTERR(1:40) 267 : C--------------------------------- 268 : C Message d'erreur standard 269 : C 21 2 270 : C Données incompatibles 271 : C-------------------------------- 271 : CALL ERREUR(21) 272 : GOTO 9999 273 : ENDIF 274 : C------------------------------------------- 275 : C******** Reading the CVs ***************** 276 : C------------------------------------------- 277 : MTYPR = ' ' 277 : CALL ACMO(IPGAS,'CV',MTYPR,ICV) 278 : IF(MTYPR .NE. 'TABLE ')THEN 279 : C-------------------------------- 280 : C Message d'erreur standard 281 : C -301 0 %m1:40 282 : C-------------------------------- 283 : MOTERR(1:40) = 'TAB1 . CV = ??? ' 284 : WRITE(IOIMP,*) MOTERR(1:40) 285 : C--------------------------------- 286 : C Message d'erreur standard 287 : C 21 2 288 : C Données incompatibles 289 : C-------------------------------- 289 : CALL ERREUR(21) 290 : GOTO 9999 291 : ENDIF 292 : C--------------------------------------------------------- 293 : C Reading Les especes qui sont dans les Equations d'Euler 294 : C--------------------------------------------------------- 295 : MTYPR = ' ' 295 : CALL ACMO(IPGAS,'ESPEULE',MTYPR,MLMOT1) 296 : IF(MTYPR .NE. 'LISTMOTS')THEN 297 : C--------------------------- 298 : C Message d'erreur standard 299 : C -301 0 %m1:40 300 : C--------------------------- 301 : MOTERR(1:40) = 'TAB1 . ESPEULE = ??? ' 302 : WRITE(IOIMP,*) MOTERR(1:40) 303 : C--------------------------- 304 : C Message d'erreur standard 305 : C 21 2 306 : C Données incompatibles 307 : C-------------------------- 307 : CALL ERREUR(21) 308 : GOTO 9999 309 : ENDIF 310 : C----------------------------------------------------------------- 311 : C Reading Nom de l'espece qui n'est pas dans les equations d'Euler 312 : C----------------------------------------------------------------- 313 : MTYPI = 'MOT ' 314 : MTYPR = ' ' 314 : CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,'ESPNEULE', LOGII,IRETI, 315 : & MTYPR,IVALR,XVALR ,CELLCH,LOGIR,IRETR) 316 : IF((IERR .NE. 0) .OR. (MTYPR .NE. 'MOT ')) THEN 317 : C------------------------------- 318 : C Message d'erreur standard 319 : C -301 0 %m1:40 320 : C------------------------------- 321 : MOTERR = 'TAB1 . ESPNEULE = ??? ' 322 : WRITE(IOIMP,*) MOTERR(1:40) 323 : C------------------------------ 324 : C Message d'erreur standard 325 : C 21 2 326 : C Données incompatibles 327 : C------------------------------ 327 : CALL ERREUR(21) 328 : GOTO 9999 329 : ENDIF 330 : C-------------------------------------------------------------- 331 : C Creating the lists of real numbers of CP and CV 332 : C-------------------------------------------------------------- 333 : SEGACT MLMOT1 334 : NESP = MLMOT1.MOTS(/2) 335 : C---------------------- 336 : C** List de CP et CV ** 337 : C---------------------- 338 : JG = NESP+1 339 : SEGINI MLRECP 340 : SEGINI MLRECV 341 : DO I1 = 1, NESP 342 : C------------------------------- 343 : C N.B. MOT1 est un CHARACTER*(4) 344 : C------------------------------- 345 : MOT1(1) = MLMOT1.MOTS(I1) 346 : MTYPI = 'MOT ' 347 : MTYPR = ' ' 347 : CALL ACCTAB(ICP,MTYPI,IVALI,XVALI,MOT1(1), LOGII,IRETI, 348 : & MTYPR,IVALR,CP ,CHARR,LOGIR,IRETR) 349 : IF((IERR .NE. 0) .OR. (MTYPR .NE. 'FLOTTANT')) THEN 350 : C------------------------------ 351 : C Message d'erreur standard 352 : C -301 0 %m1:40 353 : C------------------------------ 354 : MOTERR = 'TAB1 . CP , TAB1 . ESPEULE = ??? ' 355 : WRITE(IOIMP,*) MOTERR(1:40) 356 : C------------------------------ 357 : C Message d'erreur standard 358 : C 21 2 359 : C Données incompatibles 360 : C------------------------------ 360 : CALL ERREUR(21) 361 : GOTO 9999 362 : ENDIF 363 : MLRECP.PROG(I1) = CP 364 : C------------------------------------------- 364 : CALL ACCTAB(ICV,MTYPI,IVALI,XVALI,MOT1(1), LOGII,IRETI, 365 : & MTYPR,IVALR,CV ,CHARR,LOGIR,IRETR) 366 : IF((IERR .NE. 0) .OR. (MTYPR .NE. 'FLOTTANT')) THEN 367 : C--------------------------- 368 : C Message d'erreur standard 369 : C -301 0 %m1:40 370 : C--------------------------- 371 : MOTERR = 'TAB1 . CV , TAB1 . ESPEULE = ??? ' 372 : WRITE(IOIMP,*) MOTERR(1:40) 373 : C--------------------------- 374 : C Message d'erreur standard 375 : C 21 2 376 : C Données incompatibles 377 : C--------------------------- 377 : CALL ERREUR(21) 378 : GOTO 9999 379 : ENDIF 380 : MLRECV.PROG(I1) = CV 381 : ENDDO 382 : MTYPI = 'MOT ' 383 : MTYPR = ' ' 383 : CALL ACCTAB(ICP,MTYPI,IVALI,XVALI,CELLCH, LOGII,IRETI, 384 : & MTYPR,IVALR,CP ,CHARR,LOGIR,IRETR) 385 : IF((IERR .NE. 0) .OR. (MTYPR .NE. 'FLOTTANT')) THEN 386 : C--------------------------- 387 : C Message d'erreur standard 388 : C -301 0 %m1:40 389 : C--------------------------- 390 : MOTERR = 'TAB1 . CP , TAB1 . ESPNEULE = ??? ' 391 : WRITE(IOIMP,*) MOTERR(1:40) 392 : C--------------------------- 393 : C Message d'erreur standard 394 : C 21 2 395 : C Données incompatibles 396 : C--------------------------- 396 : CALL ERREUR(21) 397 : GOTO 9999 398 : ENDIF 399 : MLRECP.PROG(JG) = CP 400 : C 401 : MTYPI = 'MOT ' 402 : MTYPR = ' ' 402 : CALL ACCTAB(ICV,MTYPI,IVALI,XVALI,CELLCH, LOGII,IRETI, 403 : & MTYPR,IVALR,CV ,CHARR,LOGIR,IRETR) 404 : IF((IERR .NE. 0) .OR. (MTYPR .NE. 'FLOTTANT')) THEN 405 : C---------------------------- 406 : C Message d'erreur standard 407 : C -301 0 %m1:40 408 : C---------------------------- 409 : MOTERR = 'TAB1 . CV , TAB1 . ESPNEULE = ??? ' 410 : WRITE(IOIMP,*) MOTERR(1:40) 411 : C---------------------------- 412 : C Message d'erreur standard 413 : C 21 2 414 : C Données incompatibles 415 : C---------------------------- 415 : CALL ERREUR(21) 416 : GOTO 9999 417 : ENDIF 418 : MLRECV.PROG(JG) = CV 419 : C******************************************** 420 : C**** Fin de la table de gas **************** 421 : C******************************************** 422 : C-------------------------- 423 : C**** La list des inconnues 424 : C-------------------------- 425 : TYPE='LISTMOTS' 425 : CALL LIROBJ(TYPE,ILIINC,1,IRET) 426 : IF(IERR .NE. 0) GOTO 9999 427 : MLMOTS = ILIINC 428 : SEGACT MLMOTS 429 : NC = MLMOTS.MOTS(/2) 430 : SEGDES MLMOTS 431 : IF(NC .NE. (IDIM+2+NESP))THEN 432 : MOTERR(1:40) = 'LISTINCO = ???' 433 : WRITE(IOIMP,*) MOTERR 434 : C-------------------------- 435 : C Message d'erreur standard 436 : C 21 2 437 : C Données incompatibles 438 : C-------------------------- 438 : CALL ERREUR(21) 439 : GOTO 9999 440 : ENDIF 441 : C------------------------------------- 442 : C******** Boundary condition ********* 443 : C------------------------------------- 444 : IRET=0 445 : TYPE='MAILLAGE' 445 : CALL LIROBJ(TYPE,IFLIM,0,IRET) 446 : IF(IERR.NE.0)GOTO 9999 447 : IF(IRET .EQ. 0)THEN 448 : MELLIM = 0 449 : ELSE 450 : MELEME=IFLIM 451 : SEGACT MELEME 452 : ICACCA=MELEME.NUM(/2) 453 : IF(ICACCA .EQ. 0)THEN 454 : MELLIM = 0 455 : ELSE 456 : MELLIM = IFLIM 457 : ENDIF 458 : SEGDES MELEME 459 : ENDIF 460 : C-------------------------- 461 : C**** La densité au centre 462 : C-------------------------- 463 : TYPE = 'CHPOINT ' 463 : CALL LIROBJ(TYPE,IRN,1,IRET) 464 : IF(IERR .NE. 0) GOTO 9999 465 : INDIC = 1 466 : NBCOMP = 1 467 : MOT = 'SCAL' 467 : CALL QUEPOI(IRN, MELEMC, INDIC, NBCOMP, MOT) 468 : IF(IERR .NE. 0) GOTO 9999 469 : C--------------------------- 470 : C*** La vitesse au centre 471 : C--------------------------- 472 : TYPE = 'CHPOINT ' 472 : CALL LIROBJ(TYPE,IVN,1,IRET) 473 : IF(IERR .NE. 0) GOTO 9999 474 : JGN = 4 475 : JGM = IDIM 476 : SEGINI MLMVIT 477 : MLMVIT.MOTS(1) = 'UX ' 478 : MLMVIT.MOTS(2) = 'UY ' 479 : IF(IDIM .EQ. 3) MLMVIT.MOTS(3) = 'UZ ' 479 : CALL QUEPO1(IVN, MELEMC, MLMVIT) 480 : SEGSUP MLMVIT 481 : IF(IERR .NE. 0) GOTO 9999 482 : C---------------------------- 483 : C*** La pression au centre 484 : C---------------------------- 485 : TYPE = 'CHPOINT ' 485 : CALL LIROBJ(TYPE,IPN,1,IRET) 486 : IF(IERR .NE. 0) GOTO 9999 487 : INDIC = 1 488 : NBCOMP = 1 489 : MOT = 'SCAL' 489 : CALL QUEPOI(IPN, MELEMC, INDIC, NBCOMP, MOT) 490 : IF(IERR .NE. 0) GOTO 9999 491 : C----------------------------- 492 : C*** Fraction massiques 493 : C*** des especes "splittees" 494 : C----------------------------- 495 : TYPE = 'CHPOINT ' 495 : CALL LIROBJ(TYPE,IYN,1,IRET) 496 : IF(IERR .NE. 0) GOTO 9999 496 : CALL QUEPO1(IYN, MELEMC, MLMOT1) 497 : IF(IERR .NE. 0) THEN 498 : 499 : MOTERR = 'CHPO FR.MAS. = ?????' 500 : WRITE(IOIMP,*) MOTERR(1:40) 500 : CALL ERREUR(21) 501 : GOTO 9999 502 : ENDIF 503 : C----------------------------------- 504 : C**** Bas Mach 505 : C----------------------------------- 506 : IF(IIMPL .EQ. 2)THEN 507 : TYPE = 'CHPOINT ' 508 : C------------------ 509 : C******* Cut off 1 510 : C------------------ 510 : CALL LIROBJ(TYPE,IUINF,1,IRET) 511 : IF(IERR .NE. 0) GOTO 9999 512 : INDIC = 1 513 : NBCOMP = 1 514 : MOT = 'SCAL' 514 : CALL QUEPOI(IUINF, MELEMC, INDIC, NBCOMP, MOT) 515 : IF(IERR .NE. 0) GOTO 9999 516 : C----------------- 517 : C******* Cut off 2 518 : C----------------- 519 : TYPE = 'CHPOINT ' 519 : CALL LIROBJ(TYPE,IUPRI,1,IRET) 520 : IF(IERR .NE. 0) GOTO 9999 521 : INDIC = 1 522 : NBCOMP = 1 523 : MOT = 'SCAL' 523 : CALL QUEPOI(IUPRI, MELEMC, INDIC, NBCOMP, MOT) 524 : IF(IERR .NE. 0) GOTO 9999 525 : C 526 : ELSE 527 : IUINF=0 528 : IUPRI=0 529 : ENDIF 530 : C*************************************** 531 : C***** Fin reading chpoints ********* 532 : C*************************************** 533 : NESP=NESP+1 534 : IF(IIMPL .EQ. 1)THEN 535 : c------------------------------ 536 : c AUSM+ 537 : c----------------------------- 538 : IF(IDIM .EQ. 2) THEN 538 : CALL KONMSP(NESP,ILIINC,IRN,IVN,IPN,IYN,MLRECP, 539 : & MLRECV,INORM,ICHPVO,ICHPSU,MELEMC,MELEFE,MELLIM,IJACO) 540 : ELSE 540 : CALL KONMS3(NESP,ILIINC,IRN,IVN,IPN,IYN,MLRECP, 541 : & MLRECV,INORM,ICHPVO,ICHPSU,MELEMC,MELEFE,MELLIM,IJACO) 542 : ENDIF 543 : C------------------------------------------------------------ 544 : ELSEIF(IIMPL .EQ. 2)THEN 545 : C----------------------------- 546 : C********** AUSM+ low Mach 547 : C----------------------------- 548 : IF(IDIM .EQ. 2)THEN 548 : CALL KBMMS2(NESP,ILIINC,IRN,IVN,IPN,IYN,MLRECP,MLRECV, 549 : $ INORM,ICHPVO,ICHPSU, IUINF, IUPRI, MELEMC, MELEFE, 550 : $ MELLIM,IJACO) 551 : ENDIF 552 : ENDIF 553 : TYPE='MATRIK ' 553 : CALL ECROBJ(TYPE,IJACO) 554 : 9999 CONTINUE 555 : RETURN 556 : END 557 : 558 : 559 : 560 : 561 : 562 : 563 : 564 : 565 : 566 : 567 : 568 : 569 : 570 : 571 : 572 : 573 : 574 : 575 :
© Cast3M 2003 - All rights reserved.
Disclaimer