1 : C KON12 SOURCE CHAT 06/08/24 21:47:40 5529 2 : SUBROUTINE KON12 3 : C************************************************************************ 4 : C 5 : C PROJET : CASTEM 2000 6 : C 7 : C NOM : KON12 8 : C 9 : C DESCRIPTION : Subroutine appellée par KON1 10 : C 11 : C Modelisation 2D/3D des equations d'Euler 12 : C 13 : C Calcul du jacobien 14 : C 15 : C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI) 16 : C 17 : C AUTEUR : A. BECCANTINI, DRN/DMT/SEMT/LTMF 18 : C 19 : C************************************************************************ 20 : C 20 : C APPELES (Calcul) : KONJA1 (calcul du jacobien, gaz "calorically 21 : C perfect", monoespece, 2D, VLH) 21 : C KONJA3 (calcul du jacobien, gaz "calorically 22 : C perfect", monoespece, 3D, VLH) 23 : C 23 : C KONJA2 (calcul du jacobien, gaz "calorically 24 : C perfect", monoespece, 2D, AUSMplus) 24 : C KONJA4 (calcul du jacobien, gaz "calorically 25 : C perfect", monoespece, 3D, AUSMplus) 26 : C 26 : C KONJA6 (calcul du jacobien, gaz "calorically 27 : C perfect", monoespece, 2D 28 : C AUSMPLM) 28 : C KONJA7 (calcul du jacobien, gaz "calorically 29 : C perfect", monoespece, 3D 30 : C AUSMPLM) 31 : C 31 : C KONJC1 (calcul du jacobien, gaz "calorically 32 : C perfect", monoespece, 2D 33 : C CENTERED) 34 : C 34 : C KONJR1 (calcul du jacobien, gaz "calorically 35 : C perfect", monoespece, 2D 36 : C RUSANOLM) 37 : C 38 : C************************************************************************ 39 : C 40 : C*** SYNTAXE 41 : C 42 : C Discrétisation en VF "cell-centered" des équations d'Euler pour 43 : C un gaz parfait mono-constituent polytropique 44 : C Inconnues: densité, quantité de mouvement, énergie totale par 45 : C unité de volumes (variables conservatives) 46 : C 47 : C RMAT1 = 'KONV' 'VF' 'PERFMONO' 'JACOCONV' MOD1 LMOT1 48 : C (MAILIM) MOT3 CHPO1 CHPO2 CHPO3 CHPO4 ; 49 : C 50 : C or (Bas MAch) 51 : C 52 : C RMAT1 = 'KONV' 'VF' 'PERFMONO' 'JACOCONV' MOD1 LMOT1 53 : C (MAILIM) MOT3 CHPO1 CHPO2 CHPO3 CHPO4 54 : C CHPO5 CHPO6 ; 55 : C 56 : C ENTREES 57 : C 58 : C LMOT1 : objet de type LISTMOTS 59 : C Noms de composantes des variable primales et duales de RMAT1. 60 : C Il contient dans l'ordre suivant: le noms de la densité, 61 : C du momentum, de l'énergie totale par unité de volume 62 : C 63 : C MOD1 : objet modele de type Navier_Stokes 64 : C 65 : C MOT3 : objet de type MOT 66 : C 'VLH' : jacobien du residu pour la methode VLH 67 : C 'AUSMPLUS' : jacobien du residu pour la methode AUSM+ 68 : C 'AUSMPLM' : jacobien du residu pour la methode AUSM+ low 69 : C Mach 70 : C 71 : C MAILIM : MAIILAGE de POI1 ou on ne veut pas calculer le FLUX convective 72 : C 73 : C CHPO1 : CHPOINT contenant la masse volumique 74 : C (SPG = TAB1 . 'CENTRE', une seule composante, 75 : C 'SCAL'). 76 : C 77 : C CHPO2 : CHPOINT contenant la vitesse 78 : C (SPG = TAB1 . 'CENTRE', deux/trois composantes 79 : C 'UX', 'UY', 'UZ') 80 : C 81 : C CHPO3 : CHPOINT contenant la pression du gaz 82 : C (SPG = TAB1 . 'CENTRE', une seule composante, 83 : C 'SCAL'). 84 : C 85 : C CHPO4 : CHPOINT contenant le "gamma" du gaz 86 : C (SPG = TAB1 . 'CENTRE', une seule composante, 87 : C 'SCAL'). 88 : C 89 : C CHPO5 : CHPOINT contenant la premiere vitesse de cut-off 90 : C (SPG = TAB1 . 'CENTRE', une seule composante, 91 : C 'SCAL'). 92 : C 93 : C CHP06 : CHPOINT contenant la deuxieme vitesse de cut-off 94 : C (SPG = TAB1 . 'CENTRE', une seule composante, 95 : C 'SCAL'). 96 : C 97 : C SORTIES 98 : C 99 : C RMAT1 : objet de type MATRIK 100 : C (SPG = TAB1 . 'CENTRE') 101 : C (inconnues primales = inconnues duales = LMOT1) 102 : C 103 : C************************************************************************ 104 : C 105 : C HISTORIQUE (Anomalies et modifications éventuelles) 106 : C 107 : C HISTORIQUE : 108 : C 109 : C************************************************************************ 110 : C 111 : IMPLICIT INTEGER(I-N) 112 : -INC CCOPTIO 113 : -INC SMLMOTS 114 : -INC SMCHPOI 115 : -INC SMELEME 116 : POINTEUR MLMVIT.MLMOTS 117 : C 118 : C**** Variables de COOPTIO 119 : C 120 : C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR 121 : C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ 122 : C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES 123 : C & ,IECHO, IIMPI, IOSPI 124 : C & ,IDIM, IFICLE, IPREFI 125 : C & ,MCOORD 126 : C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE 127 : C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU 128 : C & ,NORINC,NORVAL,NORIND,NORVAD 129 : C & ,NUCROU, IPSAUV, IREFOR, ISAFOR 130 : C 131 : INTEGER NBJAC, IRET, INDIC, NBCOMP, NESP, JGN, JGM, MMODEL 132 : & ,IDOMA, MELEMC, MELEMF, MELEFE, MELTFA, ICHPSU, ICHPDI 133 : & ,ICHPVO, INORM 134 : & ,IJACO, ILIINC, NC, IFLIM, MELLIM, ICACCA 135 : & ,IIMPL, IRN, IVN, IPN, IGAMN, IUINF, IUPRI, INEFMD, ICOND 136 : C 137 : PARAMETER (NBJAC=5) 138 : CHARACTER*8 TYPE, LJACO(NBJAC) 139 : CHARACTER*4 MOT 140 : CHARACTER*(40) MESERR 141 : DATA LJACO/'VLH ','AUSMPLUS','AUSMPLM ','CENTERED','RUSANOLM'/ 142 : C 143 : C********************************** 144 : C**** Lecture de l'objet MODELE *** 145 : C********************************** 146 : C 147 : ICOND = 1 147 : CALL QUETYP(TYPE,ICOND,IRET) 148 : 149 : IF(IRET.EQ.0.AND.TYPE.NE.'MMODEL')THEN 150 : WRITE(6,*)' On attend un objet MMODEL' 151 : RETURN 152 : ENDIF 152 : CALL LIROBJ('MMODEL',MMODEL,ICOND,IRET) 153 : IF(IERR.NE.0)GOTO 9999 153 : CALL LEKMOD(MMODEL,IDOMA,INEFMD) 154 : IF(IERR.NE.0)GOTO 9999 155 : C 156 : C**** Centre, FACE, FACEL, ELTFA 157 : C 157 : CALL LEKTAB(IDOMA,'CENTRE',MELEMC) 158 : IF(IERR .NE. 0) GOTO 9999 159 : C 159 : CALL LEKTAB(IDOMA,'FACE',MELEMF) 160 : IF(IERR .NE. 0) GOTO 9999 161 : C 161 : CALL LEKTAB(IDOMA,'FACEL',MELEFE) 162 : IF(IERR .NE. 0) GOTO 9999 163 : C 163 : CALL LEKTAB(IDOMA,'ELTFA',MELTFA) 164 : IF(IERR .NE. 0) GOTO 9999 165 : C 166 : C**** Lecture du CHPOINT contenant les surfaces des faces. 167 : C 167 : CALL LEKTAB(IDOMA,'XXSURFAC',ICHPSU) 168 : IF(IERR .NE. 0) GOTO 9999 169 : INDIC = 1 170 : NBCOMP = 1 171 : MOT = 'SCAL' 171 : CALL QUEPOI(ICHPSU, MELEMF, INDIC, NBCOMP, MOT) 172 : IF(IERR .NE. 0) GOTO 9999 173 : C 174 : C**** Lecture du CHPOINT contenant les diametres minimums. 175 : C 175 : CALL LEKTAB(IDOMA,'XXDIEMIN',ICHPDI) 176 : IF(IERR .NE. 0) GOTO 9999 177 : INDIC = 1 178 : NBCOMP = 1 179 : MOT = 'SCAL' 179 : CALL QUEPOI(ICHPDI, MELEMC, INDIC, NBCOMP, MOT) 180 : IF(IERR .NE. 0) GOTO 9999 181 : C 182 : C**** Lecture du CHPOINT contenant les volumes 183 : C 183 : CALL LEKTAB(IDOMA,'XXVOLUM',ICHPVO) 184 : IF(IERR .NE. 0) GOTO 9999 185 : INDIC = 1 186 : NBCOMP = 1 187 : MOT = 'SCAL' 187 : CALL QUEPOI(ICHPVO, MELEMC, INDIC, NBCOMP, MOT) 188 : IF(IERR .NE. 0) GOTO 9999 189 : C 190 : C**** Les normales aux faces 191 : C 192 : IF(IDIM .EQ. 2)THEN 193 : C Que les normales 193 : CALL LEKTAB(IDOMA,'XXNORMAF',INORM) 194 : IF(IERR .NE. 0) GOTO 9999 195 : JGN = 4 196 : JGM = 2 197 : SEGINI MLMVIT 198 : MLMVIT.MOTS(1) = 'UX ' 199 : MLMVIT.MOTS(2) = 'UY ' 199 : CALL QUEPO1(INORM, MELEMF, MLMVIT) 200 : SEGSUP MLMVIT 201 : IF(IERR .NE. 0) GOTO 9999 202 : ELSE 203 : C Les normales et les tangentes 204 : TYPE = ' ' 204 : CALL ACMO(IDOMA,'MATROT',TYPE,INORM) 205 : IF (TYPE .NE. 'CHPOINT ') THEN 205 : CALL MATRAN(IDOMA,INORM) 206 : IF(IERR .NE. 0) GOTO 9999 207 : ENDIF 208 : JGN = 4 209 : JGM = 9 210 : SEGINI MLMVIT 211 : MLMVIT.MOTS(1) = 'UX ' 212 : MLMVIT.MOTS(2) = 'UY ' 213 : MLMVIT.MOTS(3) = 'UZ ' 214 : MLMVIT.MOTS(4) = 'RX ' 215 : MLMVIT.MOTS(5) = 'RY ' 216 : MLMVIT.MOTS(6) = 'RZ ' 217 : MLMVIT.MOTS(7) = 'MX ' 218 : MLMVIT.MOTS(8) = 'MY ' 219 : MLMVIT.MOTS(9) = 'MZ ' 219 : CALL QUEPO1(INORM, MELEMF, MLMVIT) 220 : SEGSUP MLMVIT 221 : ENDIF 222 : C 223 : C******************************** 224 : C**** Fin table domaine ********* 225 : C******************************** 226 : C 227 : NESP=0 228 : C 229 : C**** La list des inconnues 230 : C 231 : TYPE='LISTMOTS' 231 : CALL LIROBJ(TYPE,ILIINC,1,IRET) 232 : IF(IERR .NE. 0) GOTO 9999 233 : MLMOTS = ILIINC 234 : SEGACT MLMOTS 235 : NC = MLMOTS.MOTS(/2) 236 : SEGDES MLMOTS 237 : IF(NC .NE. (IDIM+2+NESP))THEN 238 : MOTERR(1:40) = 'LISTINCO = ???' 239 : WRITE(IOIMP,*) MOTERR 240 : C 241 : C******* Message d'erreur standard 242 : C 21 2 243 : C Données incompatibles 244 : C 244 : CALL ERREUR(21) 245 : GOTO 9999 246 : ENDIF 247 : C 248 : C**** Boundary condition 249 : C 250 : IRET=0 251 : TYPE='MAILLAGE' 251 : CALL LIROBJ(TYPE,IFLIM,0,IRET) 252 : IF(IERR.NE.0)GOTO 9999 253 : IF(IRET .EQ. 0)THEN 254 : MELLIM = 0 255 : ELSE 256 : MELEME=IFLIM 257 : SEGACT MELEME 258 : ICACCA=MELEME.NUM(/2) 259 : IF(ICACCA .EQ. 0)THEN 260 : MELLIM = 0 261 : ELSE 262 : MELLIM = IFLIM 263 : ENDIF 264 : SEGDES MELEME 265 : ENDIF 266 : C 267 : C**** Type of Jacobian 268 : C 268 : CALL LIRMOT(LJACO,NBJAC,IIMPL,1) 269 : IF(IERR .NE. 0)GOTO 9999 270 : 271 : C 272 : C******* La densité au centre 273 : C 274 : TYPE = 'CHPOINT ' 274 : CALL LIROBJ(TYPE,IRN,1,IRET) 275 : IF(IERR .NE. 0) GOTO 9999 276 : C 277 : C**** Control du CHPOINT: QUEPOI 278 : C 279 : C INDIC = 1 -> on impose le pointeur du support geometrique (ICEN) 280 : C N.B. Le CHPOINT peut changer de structure pour 281 : C avoir SPG = ICEN!!!! 282 : C INDIC = 0 -> on ne fait que verifier le support geometrique 283 : C (ICEN). Si le SPG sont differents INDIC = -4 en sortie 284 : C 285 : C NBCOMP > 0 -> numero des composantes 286 : C 287 : C MOT = ' ' obligatoire s'on connais pas les noms des composantes 288 : C 289 : INDIC = 1 290 : NBCOMP = 1 291 : MOT = 'SCAL' 291 : CALL QUEPOI(IRN, MELEMC, INDIC, NBCOMP, MOT) 292 : IF(IERR .NE. 0) GOTO 9999 293 : C 294 : C******* La vitesse au centre 295 : C 296 : TYPE = 'CHPOINT ' 296 : CALL LIROBJ(TYPE,IVN,1,IRET) 297 : IF(IERR .NE. 0) GOTO 9999 298 : JGN = 4 299 : JGM = IDIM 300 : SEGINI MLMVIT 301 : MLMVIT.MOTS(1) = 'UX ' 302 : MLMVIT.MOTS(2) = 'UY ' 303 : IF(IDIM .EQ. 3) MLMVIT.MOTS(3) = 'UZ ' 303 : CALL QUEPO1(IVN, MELEMC, MLMVIT) 304 : SEGSUP MLMVIT 305 : IF(IERR .NE. 0) GOTO 9999 306 : C 307 : C******* La pression au centre 308 : C 309 : TYPE = 'CHPOINT ' 309 : CALL LIROBJ(TYPE,IPN,1,IRET) 310 : IF(IERR .NE. 0) GOTO 9999 311 : INDIC = 1 312 : NBCOMP = 1 313 : MOT = 'SCAL' 313 : CALL QUEPOI(IPN, MELEMC, INDIC, NBCOMP, MOT) 314 : IF(IERR .NE. 0) GOTO 9999 315 : C 316 : C******* Gamma au centre 317 : C 318 : TYPE = 'CHPOINT ' 318 : CALL LIROBJ(TYPE,IGAMN,1,IRET) 319 : IF(IERR .NE. 0) GOTO 9999 320 : INDIC = 1 321 : NBCOMP = 1 322 : MOT = 'SCAL' 322 : CALL QUEPOI(IGAMN, MELEMC, INDIC, NBCOMP, MOT) 323 : IF(IERR .NE. 0) GOTO 9999 324 : C 325 : C**** Bas Mach 326 : C 327 : IF((IIMPL .EQ. 3) .OR. (IIMPL .EQ. 5))THEN 328 : TYPE = 'CHPOINT ' 329 : C 330 : C******* Cut off 1 331 : C 331 : CALL LIROBJ(TYPE,IUINF,1,IRET) 332 : IF(IERR .NE. 0) GOTO 9999 333 : INDIC = 1 334 : NBCOMP = 1 335 : MOT = 'SCAL' 335 : CALL QUEPOI(IUINF, MELEMC, INDIC, NBCOMP, MOT) 336 : IF(IERR .NE. 0) GOTO 9999 337 : C 338 : C******* Cut off 2 339 : C 340 : TYPE = 'CHPOINT ' 340 : CALL LIROBJ(TYPE,IUPRI,1,IRET) 341 : IF(IERR .NE. 0) GOTO 9999 342 : INDIC = 1 343 : NBCOMP = 1 344 : MOT = 'SCAL' 344 : CALL QUEPOI(IUPRI, MELEMC, INDIC, NBCOMP, MOT) 345 : IF(IERR .NE. 0) GOTO 9999 346 : C 347 : ELSE 348 : IUINF=0 349 : IUPRI=0 350 : ENDIF 351 : C 352 : C******* Calcul du jacobien 353 : C 354 : IF(IIMPL .EQ. 1)THEN 355 : C 356 : C********** VLH 357 : C 358 : IF(IDIM .EQ. 2)THEN 358 : CALL KONJA1(ILIINC,IRN,IVN,IPN,IGAMN,INORM 359 : $ ,ICHPVO,ICHPSU, MELEMC, MELEFE, MELLIM, IJACO) 360 : IF(IERR .NE. 0) GOTO 9999 361 : ELSE 361 : CALL KONJA3(ILIINC,IRN,IVN,IPN,IGAMN,INORM 362 : $ ,ICHPVO,ICHPSU, MELEMC, MELEFE, MELLIM, IJACO) 363 : IF(IERR .NE. 0) GOTO 9999 364 : ENDIF 365 : ELSEIF(IIMPL .EQ. 2)THEN 366 : C 367 : C********** AUSM+ 368 : C 369 : IF(IDIM .EQ. 2)THEN 369 : CALL KONJA2(ILIINC,IRN,IVN,IPN,IGAMN,INORM 370 : $ ,ICHPVO,ICHPSU, MELEMC, MELEFE, MELLIM, IJACO) 371 : IF(IERR .NE. 0) GOTO 9999 372 : ELSE 372 : CALL KONJA4(ILIINC,IRN,IVN,IPN,IGAMN,INORM 373 : $ ,ICHPVO,ICHPSU, MELEMC, MELEFE, MELLIM, IJACO) 374 : IF(IERR .NE. 0) GOTO 9999 375 : ENDIF 376 : ELSEIF(IIMPL .EQ. 3)THEN 377 : C 378 : C********** AUSM+ low Mach 379 : C 380 : IF(IDIM .EQ. 2)THEN 381 : C 381 : CALL KONJA6(ILIINC,IRN,IVN,IPN,IGAMN,INORM, 382 : $ ICHPVO,ICHPSU, IUINF, IUPRI, MELEMC, MELEFE, 383 : $ MELLIM,IJACO) 384 : ELSE 384 : CALL KONJA7(ILIINC,IRN,IVN,IPN,IGAMN,INORM, 385 : $ ICHPVO,ICHPSU, IUINF, IUPRI, MELEMC, MELEFE, 386 : $ MELLIM,IJACO) 387 : ENDIF 388 : ELSEIF(IIMPL .EQ. 4)THEN 389 : C 390 : C********** Centered 391 : C 392 : IF(IDIM .EQ. 2)THEN 393 : C 393 : CALL KONJC1(ILIINC,IRN,IVN,IPN,IGAMN,INORM, 394 : $ ICHPVO,ICHPSU, MELEMC, MELEFE, 395 : $ MELLIM,IJACO) 396 : ELSE 397 : C Tentative d'utilisation d'une option non implémentée 397 : CALL ERREUR(251) 398 : GOTO 9999 399 : ENDIF 400 : ELSEIF(IIMPL .EQ. 5)THEN 401 : C 402 : C********** RUSANOLM 403 : C 404 : IF(IDIM .EQ. 2)THEN 405 : C 405 : CALL KONJR1(ILIINC,IRN,IVN,IPN,IGAMN,INORM, 406 : $ ICHPVO,ICHPSU, IUINF, IUPRI, MELEMC, MELEFE, 407 : $ MELLIM,IJACO) 408 : ELSE 409 : C Tentative d'utilisation d'une option non implémentée 409 : CALL ERREUR(251) 410 : GOTO 9999 411 : ENDIF 412 : ELSE 413 : C Tentative d'utilisation d'une option non implémentée 413 : CALL ERREUR(251) 414 : GOTO 9999 415 : ENDIF 416 : C 417 : C**** Ecriture des resultats 418 : C 419 : TYPE='MATRIK ' 419 : CALL ECROBJ(TYPE,IJACO) 420 : 9999 CONTINUE 421 : RETURN 422 : END 423 : 424 : 425 : 426 : 427 : 428 :
© Cast3M 2003 - All rights reserved.
Disclaimer