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