1 : C PRE111 SOURCE PV 09/03/12 21:30:31 6325 2 : SUBROUTINE PRE111(ICEN,IFACE,IFACEL,INORM,IROC,IVITC,IPC,IGAMC, 3 : & IROF,IVITF,IPF,IGAMF, 4 : & LOGAN,LOGNEG,LOGBOR,MESERR,VALER,VAL1,VAL2) 5 : C************************************************************************ 6 : C 7 : C PROJET : CASTEM 2000 8 : C 9 : C NOM : PRE111 10 : C 11 : C DESCRIPTION : Voir PRE11 12 : C 13 : C Cas Deux Dimensions 14 : C 15 : C Une Espece 16 : C 17 : C 1er ordre en espace, 1re ordre en temps 18 : C 19 : C Creations des objets MCHAML IROF, IVITF, IPF, 20 : C IGAMF 21 : C 22 : C 23 : C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI) 24 : C 25 : C AUTEUR : A. BECCANTINI, DRN/DMT/SEMT/TTMF 26 : C 27 : C************************************************************************ 28 : C 29 : C 30 : C APPELES (Outils) : KRIPAD, LICHT 31 : C 32 : C APPELES (Calcul) : AUCUN 33 : C 34 : C 35 : C************************************************************************ 36 : C 37 : C ENTREES 38 : C 39 : C 1) Pointeurs de MELEMEs et de CHPOINTs de la table DOMAINE 40 : C 41 : C ICEN : MELEME de 'POI1' SPG des CENTRES 42 : C 43 : C IFACE : MELEME de 'POI1' SPG des FACES 44 : C 45 : C IFACEL : MELEME de 'SEG3' avec 46 : C CENTRE d'Elt "gauche" 47 : C CENTRE de Face 48 : C CENTRE d'Elt "droite" 49 : C 50 : C N.B. = IFACE.NUM(i,1) = IFACEL.NUM(i,2) 51 : C 52 : C INORM : CHPOINT des cosinus directeurs de normales aux faces 53 : C 54 : C 2) Pointeurs des CHPOINTs 55 : C 56 : C IROC : CHPOINT "CENTRE" contenant la masse volumique RHO 57 : C 58 : C IVITC : CHPOINT "CENTRE" contenant la vitesse UX, UY ; 59 : C 60 : C IPC : CHPOINT "CENTRE" contenat la pression P; 61 : C 62 : C IGAMC : CHPOINT "CENTRE" contenat le "Gamma" du gaz 63 : C 64 : C 65 : C SORTIES 66 : C 67 : C 68 : C IROF : MCHAML defini sur le MELEME de pointeur IFACEL, 69 : C contenant la masse volumique RHO 70 : C 71 : C IVITF : MCHAML defini sur le MELEME de pointeur IFACEL, 72 : C contenant la vitesse UN, UT dans le repaire local 73 : C (n,t) et defini sur le MELEME de pointeur IFACE, 74 : C contenant les cosinus directeurs du repere local 75 : C 76 : C IPF : MCHAML defini sur le MELEME de pointeur IFACEL, 77 : C contenant la pression P 78 : C 79 : C IGAMF : MCHAML defini sur le MELEME de pointeur IFACEL, 80 : C contenant le "gamma" du gaz 81 : C 82 : C LOGAN : anomalie detectee (changement de la convention dans 83 : C la table domaine) 84 : C 85 : C LOGNEG : (LOGICAL): si .TRUE. une pression ou une densité 86 : C negative a été detectée -> en interactif le 87 : C programme s'arrete en GIBIANE 88 : C (erreur stocké en MESERR et VALER) 89 : C 90 : C LOGBOR : (LOGICAL): si .TRUE. un gamma a ete detecte 91 : C dehor 1 et 3 (sa valeur stockée en MESERR et VALER; 92 : C en VAL1 et en VAL2 on stocke 1.0 et 3.0) 93 : C 94 : C MESERR 95 : C VALER 96 : C VAL1, 97 : C VAL2 : pour les messages d'erreur 98 : C 99 : C************************************************************************ 100 : C 101 : C HISTORIQUE (Anomalies et modifications éventuelles) 102 : C 103 : C HISTORIQUE : Créée le 11.6.98. 104 : C 105 : C************************************************************************ 106 : C 107 : C 108 : C ATTENTION: Cet programme marche que si le MAILLAGE est convex; 109 : C si non il faut changer l'argoritme de calcul de 110 : C l'orientation des normales aux faces. 111 : C 112 : C 113 : C************************************************************************ 114 : C 115 : C**** Variables de COOPTIO 116 : C 117 : C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR 118 : C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ 119 : C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES 120 : C & ,IECHO, IIMPI, IOSPI 121 : C & ,IDIM 122 : CC & ,MCOORD 123 : C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE 124 : C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU 125 : C & ,NORINC,NORVAL,NORIND,NORVAD 126 : C & ,NUCROU, IPSAUV 127 : C 128 : C**** Les variables 129 : C 130 : IMPLICIT INTEGER(I-N) 131 : INTEGER ICEN, IFACE, IFACEL, IROC, IVITC, IPC ,IGAMC, INORM 132 : & , IROF, IVITF, IPF, IGAMF 133 : & , IGEOM, NFAC 134 : & , N1PTEL, N1EL, N2PTEL, N2EL, N2, N1, N3, L1 135 : & , NLCF, NGCF, NGCEG, NLCEG, NGCED, NLCED, NGCF1 136 : REAL*8 VALER, VAL1, VAL2, XG, YG, XC, YC, DXG, DYG 137 : & , CNX, CNY, CTX, CTY, ORIENT 138 : & , ROG, PG, GAMG, UXG, UYG, UNG, UTG 139 : & , ROD, PD, GAMD, UXD, UYD, UND, UTD 140 : CHARACTER*(40) MESERR 141 : CHARACTER*(8) TYPE 142 : LOGICAL LOGAN,LOGNEG, LOGBOR 143 : C 144 : C**** Les Includes 145 : C 146 : -INC SMCOORD 147 : -INC CCOPTIO 148 : -INC SMCHPOI 149 : POINTEUR MPROC.MPOVAL, MPVITC.MPOVAL, MPPC.MPOVAL, 150 : & MPGAMC.MPOVAL, MPNORM.MPOVAL 151 : -INC SMCHAML 152 : POINTEUR MELVNX.MELVAL, MELVNY.MELVAL, 153 : & MELT1X.MELVAL, MELT1Y.MELVAL 154 : POINTEUR MELVUN.MELVAL, MELVUT.MELVAL 155 : POINTEUR MELRO.MELVAL, MELP.MELVAL, 156 : & MELGAM.MELVAL 157 : -INC SMLENTI 158 : -INC SMELEME 159 : C 160 : C**** Initialisation des parametres d'erreur déjà faite, i.e. 161 : C 162 : C LOGNEG = .FALSE. 163 : C LOGBOR = .FALSE. 164 : C MESERR = ' ' 165 : C MOTERR(1:40) = MESERR(1:40) 166 : C VALER = 0.0D0 167 : C VAL1 = 0.0D0 168 : C VAL2 = 0.0D0 169 : C 170 : C 171 : C**** KRIPAD pour la correspondance global/local de centre 172 : C 172 : CALL KRIPAD(ICEN,MLENT1) 173 : C 174 : C**** MLENTI1 a MCORD.XCOORD(/1)/(IDIM+1) elements 175 : C 176 : C Si i est le numero global d'un noeud de ICEN, 177 : C MLENT1.LECT(i) contient sa position, i.e. 178 : C 179 : C I = numero global du noeud centre 180 : C MLENT1.LECT(i) = numero local du noeud centre 181 : C 182 : C MLENT1 déjà activé, i.e. 183 : C 184 : C SEGACT MLENT1 185 : C 186 : C**** Activation de CHPOINTs 187 : C 188 : C densité 189 : C vitesse 190 : C pression 191 : C gamma 192 : C cosinus directeurs des normales aux surface 193 : C 193 : CALL LICHT(IROC ,MPROC ,TYPE,IGEOM) 193 : CALL LICHT(IVITC,MPVITC,TYPE,IGEOM) 193 : CALL LICHT(IPC ,MPPC ,TYPE,IGEOM) 193 : CALL LICHT(IGAMC,MPGAMC,TYPE,IGEOM) 193 : CALL LICHT(INORM,MPNORM,TYPE,IGEOM) 194 : C 195 : C**** MPOVA1 - MPOVA5 sont déjà activés i.e.: 196 : C 197 : C SEGACT MPROC 198 : C SEGACT MPVITC 199 : C SEGACT MPPC 200 : C SEGACT MPGAMC 201 : C SEGACT MPNORM 202 : C 203 : C**** Le MELEME FACEL 204 : C 205 : IPT1 = IFACEL 206 : IPT2 = IFACE 207 : SEGACT IPT1 208 : SEGACT IPT2 209 : NFAC = IPT1.NUM(/2) 210 : C 211 : C**** Creation de MCHAMLs contenant les etats gauche et droite, 212 : C 213 : C i.e.: 214 : C 215 : C vitesse + cosinus directors du repere local 216 : C densité 217 : C pression 218 : C gamma 219 : C 220 : C**** Cosinus directors du repere local et vitesse 221 : C 222 : C Les cosinus directeurs 223 : C 224 : N1 = 2 225 : N3 = 6 226 : L1 = 28 227 : SEGINI MCHEL1 228 : IVITF = MCHEL1 229 : MCHEL1.TITCHE = 'U ' 230 : MCHEL1.IMACHE(1) = IFACE 231 : MCHEL1.IMACHE(2) = IFACEL 232 : MCHEL1.CONCHE(1) = ' (n,t) in (x,y) ' 233 : MCHEL1.CONCHE(2) = ' U in (n,t) ' 234 : C 235 : C**** Valeurs des cosinus definies par respect au repair global, i.e. 236 : C 237 : MCHEL1.INFCHE(1,1) = 2 238 : MCHEL1.INFCHE(1,3) = NIFOUR 239 : MCHEL1.INFCHE(1,4) = 0 240 : MCHEL1.INFCHE(1,5) = 0 241 : MCHEL1.INFCHE(1,6) = 0 242 : MCHEL1.IFOCHE = IFOUR 243 : C 244 : C**** Valeurs de vitesse definies par respect au repair local, i.e. 245 : C 246 : MCHEL1.INFCHE(2,1) = 1 247 : MCHEL1.INFCHE(2,3) = NIFOUR 248 : MCHEL1.INFCHE(2,4) = 0 249 : MCHEL1.INFCHE(2,5) = 0 250 : MCHEL1.INFCHE(2,6) = 0 251 : C 252 : C**** Le cosinus directeurs 253 : C 254 : N1PTEL = 1 255 : N1EL = NFAC 256 : N2PTEL = 0 257 : N2EL = 0 258 : C 259 : C**** MCHAML a N2 composantes: 260 : C 261 : C cosinus directeurs du repere local (n,t1) 262 : C 263 : C IDIM = 2 -> 4 composantes 264 : C 265 : N2 = 4 266 : SEGINI MCHAM1 267 : MCHEL1.ICHAML(1) = MCHAM1 268 : MCHAM1.NOMCHE(1) = 'NX ' 269 : MCHAM1.NOMCHE(2) = 'NY ' 270 : MCHAM1.NOMCHE(3) = 'TX ' 271 : MCHAM1.NOMCHE(4) = 'TY ' 272 : MCHAM1.TYPCHE(1) = 'REAL*8 ' 273 : MCHAM1.TYPCHE(2) = 'REAL*8 ' 274 : MCHAM1.TYPCHE(3) = 'REAL*8 ' 275 : MCHAM1.TYPCHE(4) = 'REAL*8 ' 276 : SEGINI MELVNX 277 : SEGINI MELVNY 278 : SEGINI MELT1X 279 : SEGINI MELT1Y 280 : MCHAM1.IELVAL(1) = MELVNX 281 : MCHAM1.IELVAL(2) = MELVNY 282 : MCHAM1.IELVAL(3) = MELT1X 283 : MCHAM1.IELVAL(4) = MELT1Y 284 : SEGDES MCHAM1 285 : C 286 : C**** Vitesse 287 : C 288 : N1EL = NFAC 289 : N1PTEL = 3 290 : N2EL = 0 291 : N2PTEL = 0 292 : C 293 : C**** MCHAML a N2 composantes: 294 : C 295 : C IDIM = 2 -> 2 composantes 296 : C 297 : N2 = 2 298 : SEGINI MCHAM1 299 : MCHEL1.ICHAML(2) = MCHAM1 300 : SEGDES MCHEL1 301 : MCHAM1.NOMCHE(1) = 'UN ' 302 : MCHAM1.NOMCHE(2) = 'UT ' 303 : MCHAM1.TYPCHE(1) = 'REAL*8 ' 304 : MCHAM1.TYPCHE(2) = 'REAL*8 ' 305 : SEGINI MELVUN 306 : SEGINI MELVUT 307 : MCHAM1.IELVAL(1) = MELVUN 308 : MCHAM1.IELVAL(2) = MELVUT 309 : SEGDES MCHAM1 310 : C 311 : C**** Densite 312 : C 313 : N1 = 1 314 : N3 = 6 315 : L1 = 15 316 : SEGINI MCHEL2 317 : IROF = MCHEL2 318 : MCHEL2.IMACHE(1) = IFACEL 319 : MCHEL2.TITCHE = 'RO ' 320 : MCHEL2.CONCHE(1) = ' ' 321 : C 322 : C**** Valeurs independente du repére, i.e. 323 : C 324 : MCHEL2.INFCHE(1,1) = 0 325 : MCHEL2.INFCHE(1,3) = NIFOUR 326 : MCHEL2.INFCHE(1,4) = 0 327 : MCHEL2.INFCHE(1,5) = 0 328 : MCHEL2.INFCHE(1,6) = 0 329 : MCHEL2.IFOCHE = IFOUR 330 : N2 = 1 331 : SEGINI MCHAM1 332 : MCHEL2.ICHAML(1) = MCHAM1 333 : SEGDES MCHEL2 334 : MCHAM1.NOMCHE(1) = 'SCAL ' 335 : MCHAM1.TYPCHE(1) = 'REAL*8 ' 336 : SEGINI MELRO 337 : MCHAM1.IELVAL(1) = MELRO 338 : SEGDES MCHAM1 339 : C 340 : C**** Pression 341 : C 342 : MCHEL1 = IROF 343 : SEGINI, MCHEL2 = MCHEL1 344 : IPF = MCHEL2 345 : MCHEL2.TITCHE = 'P ' 346 : C 347 : C**** MCHAM1 = MCHAML de la densite 348 : C 349 : SEGINI, MCHAM2 = MCHAM1 350 : MCHEL2.ICHAML(1) = MCHAM2 351 : SEGDES MCHEL2 352 : SEGINI MELP 353 : MCHAM2.IELVAL(1) = MELP 354 : SEGDES MCHAM2 355 : C 356 : C**** Gamma 357 : C 358 : MCHEL1 = IROF 359 : SEGINI, MCHEL2 = MCHEL1 360 : IGAMF = MCHEL2 361 : MCHEL2.TITCHE = 'GAMMA ' 362 : C 363 : C**** MCHAM1 = MCHAML de la densite 364 : C 365 : SEGINI, MCHAM2 = MCHAM1 366 : MCHEL2.ICHAML(1) = MCHAM2 367 : SEGDES MCHEL2 368 : SEGINI MELGAM 369 : MCHAM2.IELVAL(1) = MELGAM 370 : SEGDES MCHAM2 371 : C 372 : C**** Recapitulatif: les MELVALs et les MPOVALs actives 373 : C 374 : C MELVNX, MELVNY 375 : C MELT1X, MELT1Y 376 : C 377 : C MELVUN, MELVUT -> vitesse 378 : C 379 : C MELRO -> densite 380 : C 381 : C MELP -> pression 382 : C 383 : C MELGAM -> gamma 384 : C 385 : C MPROC -> densite 386 : C 387 : C MPVITC -> vitesse 388 : C 389 : C MPPC -> pression 390 : C 391 : C MPGAMC -> gamma 392 : C 393 : C MPNORM -> normales aux faces 394 : C 395 : C**** Boucle sur le faces 396 : C 397 : DO NLCF = 1, NFAC 398 : C 399 : C******* NLCF = numero local du centre de face 400 : C NGCF = numero global du centre de face 401 : C NGCEG = numero global du centre ELT "gauche" 402 : C NLCEG = numero local du centre ELT "gauche" 403 : C NGCED = numero global du centre ELT "droite" 404 : C NLCED = numero local du centre ELT "droite" 405 : C 406 : NGCEG = IPT1.NUM(1,NLCF) 407 : NGCF = IPT1.NUM(2,NLCF) 408 : NGCED = IPT1.NUM(3,NLCF) 409 : NLCEG = MLENT1.LECT(NGCEG) 410 : NLCED = MLENT1.LECT(NGCED) 411 : C 412 : C******* TEST: IPT2.NUM(1,NLCF) = IPT1.NUM(2,NLCF) 413 : C 414 : NGCF1 = IPT2.NUM(1,NLCF) 415 : IF( NGCF1 .NE. NGCF) THEN 416 : LOGAN = .TRUE. 417 : MESERR(1:40) = 'PRET, subroutine pre111.eso ' 418 : GOTO 9999 419 : ENDIF 420 : C 421 : C******* Cosinus directeurs des NORMALES aux faces 422 : C 423 : C On impose que les normales sont direct "Gauche" -> "Centre" 424 : C 425 : XG = XCOOR((NGCEG-1)*(IDIM+1)+1) 426 : YG = XCOOR((NGCEG-1)*(IDIM+1)+2) 427 : XC = XCOOR((NGCF-1)*(IDIM+1)+1) 428 : YC = XCOOR((NGCF-1)*(IDIM+1)+2) 429 : DXG = XC - XG 430 : DYG = YC - YG 431 : 432 : C 433 : C******* On calcule le sign du pruduit scalare 434 : C (Normales de Castem) * (vecteur "gauche" -> "centre") 435 : C 436 : CNX = MPNORM.VPOCHA(NLCF,1) 437 : CNY = MPNORM.VPOCHA(NLCF,2) 438 : ORIENT = CNX * DXG + CNY * DYG 439 : ORIENT = SIGN(1.0D0,ORIENT) 440 : IF(ORIENT .NE. 1.0D0)THEN 441 : LOGAN = .TRUE. 442 : MESERR(1:30)= 443 : & 'PRET , subroutine pre111.eso. ' 444 : GOTO 9999 445 : ENDIF 446 : CNX = CNX * ORIENT 447 : CNY = CNY * ORIENT 448 : C 449 : C********** Cosinus directeurs de tangent 2D 450 : C 451 : CTX = -1.0D0 * CNY 452 : CTY = CNX 453 : C 454 : C 455 : C******* Les autres MELVALs 456 : C 457 : C 458 : C******* N.B.: On suppose qu'on a déjà controlle RO, P > 0 459 : C GAMMA \in (1,3) 460 : C Si non il faut le faire, en utlisant LOGBOR, 461 : C LOGNEG, VALER, VAL1, VAL2 462 : C 463 : C 464 : C 465 : C******* NGCEG = NGCED -> Mur 466 : C 467 : IF( NGCEG .EQ. NGCED)THEN 468 : ROG = MPROC.VPOCHA(NLCEG , 1) 469 : PG = MPPC.VPOCHA(NLCEG, 1) 470 : GAMG = MPGAMC.VPOCHA(NLCEG, 1) 471 : UXG = MPVITC.VPOCHA(NLCEG , 1) 472 : UYG = MPVITC.VPOCHA(NLCEG , 2) 473 : UNG = UXG * CNX + UYG * CNY 474 : UTG = UXG * CTX + UYG * CTY 475 : C 476 : C********** Son etat droite 477 : C 478 : ROD = ROG 479 : PD = PG 480 : GAMD = GAMG 481 : UND = -1.0D0 * UNG 482 : UTD = UTG 483 : C 484 : C************* Fin cas mur 485 : C 486 : ELSE 487 : C 488 : C************* Etat gauche 489 : C 490 : ROG = MPROC.VPOCHA(NLCEG, 1) 491 : PG = MPPC.VPOCHA(NLCEG, 1) 492 : GAMG = MPGAMC.VPOCHA(NLCEG, 1) 493 : UXG = MPVITC.VPOCHA(NLCEG , 1) 494 : UYG = MPVITC.VPOCHA(NLCEG , 2) 495 : UNG = UXG * CNX + UYG * CNY 496 : UTG = UXG * CTX + UYG * CTY 497 : C 498 : C********** Etat gauche 499 : C 500 : ROD = MPROC.VPOCHA(NLCED,1) 501 : PD = MPPC.VPOCHA(NLCED,1) 502 : GAMD = MPGAMC.VPOCHA(NLCED,1) 503 : C 504 : C************* On suppose qu'on a déjà controlle ROG, PG > 0 505 : C Si non il faut le faire!!! 506 : C 507 : UXD = MPVITC.VPOCHA(NLCED,1) 508 : UYD = MPVITC.VPOCHA(NLCED,2) 509 : UND = UXD * CNX + UYD * CNY 510 : UTD = UXD * CTX + UYD * CTY 511 : ENDIF 512 : C 513 : C************* Les MELVALs 514 : C 515 : MELRO.VELCHE(1,NLCF) = ROG 516 : MELRO.VELCHE(3,NLCF) = ROD 517 : MELP.VELCHE(1,NLCF) = PG 518 : MELP.VELCHE(3,NLCF) = PD 519 : MELGAM.VELCHE(1,NLCF) = GAMG 520 : MELGAM.VELCHE(3,NLCF) = GAMD 521 : MELVUN.VELCHE(1,NLCF) = UNG 522 : MELVUN.VELCHE(3,NLCF) = UND 523 : MELVUT.VELCHE(1,NLCF) = UTG 524 : MELVUT.VELCHE(3,NLCF) = UTD 525 : MELVNX.VELCHE(1,NLCF) = CNX 526 : MELVNY.VELCHE(1,NLCF) = CNY 527 : MELT1X.VELCHE(1,NLCF) = CTX 528 : MELT1Y.VELCHE(1,NLCF) = CTY 529 : ENDDO 530 : C 531 : C**** Desactivation des SEGMENTs 532 : C 533 : SEGDES IPT1 534 : SEGDES IPT2 535 : C 536 : SEGDES MPROC 537 : SEGDES MPVITC 538 : SEGDES MPPC 539 : SEGDES MPGAMC 540 : SEGDES MPNORM 541 : C 542 : SEGDES MELRO 543 : SEGDES MELP 544 : SEGDES MELGAM 545 : SEGDES MELVUN 546 : SEGDES MELVUT 547 : SEGDES MELVNX 548 : SEGDES MELVNY 549 : SEGDES MELT1X 550 : SEGDES MELT1Y 551 : C 552 : C**** Destruction du MELNTI correspondance local/global 553 : C 554 : SEGSUP MLENT1 555 : C 556 : 9999 CONTINUE 557 : C 558 : RETURN 559 : END 560 : 561 : 562 : 563 : 564 : 565 : 566 : 567 :
© Cast3M 2003 - All rights reserved.
Disclaimer