1 : C PRE312 SOURCE PV 09/03/12 21:30:54 6325 2 : SUBROUTINE PRE312(ICEN,IFACE,IFACEL,INORM,IROC,IVITC,IPC, 3 : & IYC,ISCAC, 4 : & IROF,IVITF,IPF,IYF,ISCAF, 5 : & LOGAN,LOGNEG,LOGBOR,MESERR,VALER,VAL1,VAL2) 6 : C************************************************************************ 7 : C 8 : C PROJET : CASTEM 2000 9 : C 10 : C NOM : PRE312 11 : C 12 : C DESCRIPTION : Voir PRE31 13 : C 14 : C Cas Trois Dimensions 15 : C 16 : C Mono/MultiEspeces 17 : C 18 : C 1er ordre en espace, 1re ordre en temps 19 : C 20 : C Creations des objets MCHAML IROF, IVITF, IPF,IYF 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, UZ ; 59 : C 60 : C IPC : CHPOINT "CENTRE" contenat la pression P; 61 : C 62 : C IYC : CHPOINT "CENTRE" contenat les fractions massiques 63 : C (ou 0 dans le cas monoespece); 64 : C 65 : C ISCAC : CHPOINT "CENTRE" contenat les scalaires passifs 66 : C (ou 0); 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, UT1, UT2 dans le repaire 77 : C local (n,t1,t2) et defini sur le MELEME de pointeur 78 : C IFACE, 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 (ou 0 dans le cas 85 : C monoespece); 86 : C 87 : C ISCAF : MCHAML defini sur le MELEME de pointeur IFACEL, 88 : C contenant les scalaire passifs (ou 0) 89 : C 90 : C LOGAN : anomalie detectee (changement de la convention dans 91 : C la table domaine) 92 : C 93 : C LOGNEG : (LOGICAL): si .TRUE. une pression ou une densité 94 : C negative a été detectée -> en interactif le 95 : C programme s'arrete en GIBIANE 96 : C (erreur stocké en MESERR et VALER) 97 : C 98 : C LOGBOR : (LOGICAL): si .TRUE. un Y a ete detecte 99 : C dehor 1 et 3 (sa valeur stockée en MESERR et VALER; 100 : C en VAL1 et en VAL2 on stocke 1.0 et 3.0) 101 : C 102 : C MESERR 103 : C VALER 104 : C VAL1, 105 : C VAL2 : pour les messages d'erreur 106 : C 107 : C************************************************************************ 108 : C 109 : C HISTORIQUE (Anomalies et modifications éventuelles) 110 : C 111 : C HISTORIQUE : Créée le 18.12.98. 112 : C 113 : C 17.02.2000: transport des scalaires passifs 114 : C 115 : C************************************************************************ 116 : C 117 : C 118 : C ATTENTION: Cet programme marche si le MAILLAGE est convex; 119 : C si non il faut changer l'argoritme de calcul de 120 : C l'orientation des normales aux faces. 121 : C 122 : C 123 : C************************************************************************ 124 : C 125 : C**** Variables de COOPTIO 126 : C 127 : C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR 128 : C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ 129 : C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES 130 : C & ,IECHO, IIMPI, IOSPI 131 : C & ,IDIM 132 : CC & ,MCOORD 133 : C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE 134 : C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU 135 : C & ,NORINC,NORVAL,NORIND,NORVAD 136 : C & ,NUCROU, IPSAUV 137 : C 138 : C**** Les variables 139 : C 140 : IMPLICIT INTEGER(I-N) 141 : INTEGER ICEN, IFACE, IFACEL, IROC, IVITC, IPC ,IYC, INORM 142 : & , IROF, IVITF, IPF, IYF, NESP, ISCAC, ISCAF, NSCA 143 : & , IGEOM, NFAC 144 : & , N1PTEL, N1EL, N2PTEL, N2EL, N2, N1, N3, L1 145 : & , NLCF, NGCF, NGCEG, NLCEG, NGCED, NLCED, NGCF1, I1, NMA 146 : & , INDCEL 147 : REAL*8 VALER, VAL1, VAL2,XG,YG,ZG,XC,YC,ZC 148 : & ,DXG, DYG, DZG,ORIENT 149 : & , CNX, CNY, CNZ, CTX, CTY, CTZ, CVX, CVY, CVZ 150 : & , ROG, PG, UXG, UYG, UZG, UNG, UTG, UVG 151 : & , ROD, PD, UXD, UYD, UZD, UND, UTD, UVD 152 : CHARACTER*(40) MESERR 153 : CHARACTER*(8) TYPE, CARCEL 154 : LOGICAL LOGAN,LOGNEG, LOGBOR 155 : C 156 : C**** Les Includes 157 : C 158 : -INC SMCOORD 159 : -INC CCOPTIO 160 : -INC SMCHPOI 161 : POINTEUR MPROC.MPOVAL, MPVITC.MPOVAL, MPPC.MPOVAL, 162 : & MPNORM.MPOVAL, MPYC.MPOVAL, MPSC.MPOVAL 163 : -INC SMCHAML 164 : POINTEUR MELVNX.MELVAL, MELVNY.MELVAL, MELVNZ.MELVAL, 165 : & MELT1X.MELVAL, MELT1Y.MELVAL, MELT1Z.MELVAL, 166 : & MELT2X.MELVAL, MELT2Y.MELVAL, MELT2Z.MELVAL 167 : POINTEUR MELVUN.MELVAL, MELVUT.MELVAL, MELVUV.MELVAL 168 : POINTEUR MELRO.MELVAL, MELP.MELVAL 169 : POINTEUR MCHAMY.MCHAML, MCHAMS.MCHAML 170 : -INC SMLENTI 171 : -INC SMELEME 172 : C 173 : C**** Segments des fractions massiques gauche et droit 174 : C 175 : SEGMENT FRAMAS 176 : REAL*8 FRAMG(NMA), FRAMD(NMA) 177 : ENDSEGMENT 178 : POINTEUR SCALPA.FRAMAS 179 : C 180 : C**** Initialisation des parametres d'erreur déjà faite, i.e. 181 : C 182 : C LOGNEG = .FALSE. 183 : C LOGBOR = .FALSE. 184 : C MESERR = ' ' 185 : C MOTERR(1:40) = MESERR(1:40) 186 : C VALER = 0.0D0 187 : C VAL1 = 0.0D0 188 : C VAL2 = 0.0D0 189 : C 190 : C 191 : C**** KRIPAD pour la correspondance global/local de centre 192 : C 192 : CALL KRIPAD(ICEN,MLENT1) 193 : C 194 : C**** MLENTI1 a MCORD.XCOORD(/1)/(IDIM+1) elements 195 : C 196 : C Si i est le numero global d'un noeud de ICEN, 197 : C MLENT1.LECT(i) contient sa position, i.e. 198 : C 199 : C I = numero global du noeud centre 200 : C MLENT1.LECT(i) = numero local du noeud centre 201 : C 202 : C MLENT1 déjà activé, i.e. 203 : C 204 : C SEGACT MLENT1 205 : C 206 : C**** Activation de CHPOINTs 207 : C 208 : C densité 209 : C vitesse 210 : C pression 211 : C cosinus directeurs des normales aux surface 212 : C 212 : CALL LICHT(IROC ,MPROC ,TYPE,IGEOM) 212 : CALL LICHT(IVITC,MPVITC,TYPE,IGEOM) 212 : CALL LICHT(IPC ,MPPC ,TYPE,IGEOM) 212 : CALL LICHT(INORM,MPNORM,TYPE,IGEOM) 213 : C 214 : C**** MPOVA1 - MPOVA5 sont déjà activés i.e.: 215 : C 216 : C SEGACT MPROC 217 : C SEGACT MPVITC 218 : C SEGACT MPPC 219 : C SEGACT MPNORM 220 : C 221 : C 222 : C**** Le MELEME FACEL 223 : C 224 : IPT1 = IFACEL 225 : IPT2 = IFACE 226 : SEGACT IPT1 227 : SEGACT IPT2 228 : NFAC = IPT1.NUM(/2) 229 : C 230 : C**** Creation de MCHAMLs contenant les etats gauche et droite, 231 : C 232 : C i.e.: 233 : C 234 : C vitesse + cosinus directors du repere local 235 : C densité 236 : C pression 237 : C fractions massiques 238 : C 239 : C**** Cosinus directors du repere local et vitesse 240 : C 241 : C Les cosinus directeurs 242 : C 243 : N1 = 2 244 : N3 = 6 245 : L1 = 28 246 : SEGINI MCHEL1 247 : IVITF = MCHEL1 248 : MCHEL1.TITCHE = 'U ' 249 : MCHEL1.IMACHE(1) = IFACE 250 : MCHEL1.IMACHE(2) = IFACEL 251 : MCHEL1.CONCHE(1) = '(n,t,v)in(x,y,z)' 252 : MCHEL1.CONCHE(2) = ' U in (n,t,v) ' 253 : C 254 : C**** Valeurs des cosinus definies par respect au repair global, i.e. 255 : C 256 : MCHEL1.INFCHE(1,1) = 2 257 : MCHEL1.INFCHE(1,3) = NIFOUR 258 : MCHEL1.INFCHE(1,4) = 0 259 : MCHEL1.INFCHE(1,5) = 0 260 : MCHEL1.INFCHE(1,6) = 0 261 : MCHEL1.IFOCHE = IFOUR 262 : C 263 : C**** Valeurs de vitesse definies par respect au repair local, i.e. 264 : C 265 : MCHEL1.INFCHE(2,1) = 1 266 : MCHEL1.INFCHE(2,3) = NIFOUR 267 : MCHEL1.INFCHE(2,4) = 0 268 : MCHEL1.INFCHE(2,5) = 0 269 : MCHEL1.INFCHE(2,6) = 0 270 : C 271 : C**** Le cosinus directeurs 272 : C 273 : N1PTEL = 1 274 : N1EL = NFAC 275 : N2PTEL = 0 276 : N2EL = 0 277 : C 278 : C**** MCHAML a N2 composantes: 279 : C 280 : C cosinus directeurs du repere local (n,t1,t2) 281 : C 282 : C IDIM = 3 -> 9 composantes 283 : C 284 : N2 = 9 285 : SEGINI MCHAM1 286 : MCHEL1.ICHAML(1) = MCHAM1 287 : MCHAM1.NOMCHE(1) = 'NX ' 288 : MCHAM1.NOMCHE(2) = 'NY ' 289 : MCHAM1.NOMCHE(3) = 'NZ ' 290 : MCHAM1.NOMCHE(4) = 'TX ' 291 : MCHAM1.NOMCHE(5) = 'TY ' 292 : MCHAM1.NOMCHE(6) = 'TZ ' 293 : MCHAM1.NOMCHE(7) = 'VX ' 294 : MCHAM1.NOMCHE(8) = 'VY ' 295 : MCHAM1.NOMCHE(9) = 'VZ ' 296 : MCHAM1.TYPCHE(1) = 'REAL*8 ' 297 : MCHAM1.TYPCHE(2) = 'REAL*8 ' 298 : MCHAM1.TYPCHE(3) = 'REAL*8 ' 299 : MCHAM1.TYPCHE(4) = 'REAL*8 ' 300 : MCHAM1.TYPCHE(5) = 'REAL*8 ' 301 : MCHAM1.TYPCHE(6) = 'REAL*8 ' 302 : MCHAM1.TYPCHE(7) = 'REAL*8 ' 303 : MCHAM1.TYPCHE(8) = 'REAL*8 ' 304 : MCHAM1.TYPCHE(9) = 'REAL*8 ' 305 : SEGINI MELVNX 306 : SEGINI MELVNY 307 : SEGINI MELVNZ 308 : SEGINI MELT1X 309 : SEGINI MELT1Y 310 : SEGINI MELT1Z 311 : SEGINI MELT2X 312 : SEGINI MELT2Y 313 : SEGINI MELT2Z 314 : MCHAM1.IELVAL(1) = MELVNX 315 : MCHAM1.IELVAL(2) = MELVNY 316 : MCHAM1.IELVAL(3) = MELVNZ 317 : MCHAM1.IELVAL(4) = MELT1X 318 : MCHAM1.IELVAL(5) = MELT1Y 319 : MCHAM1.IELVAL(6) = MELT1Z 320 : MCHAM1.IELVAL(7) = MELT2X 321 : MCHAM1.IELVAL(8) = MELT2Y 322 : MCHAM1.IELVAL(9) = MELT2Z 323 : SEGDES MCHAM1 324 : C 325 : C**** Vitesse 326 : C 327 : N1EL = NFAC 328 : N1PTEL = 3 329 : N2EL = 0 330 : N2PTEL = 0 331 : C 332 : C**** MCHAML a N2 composantes: 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 : IF(IYC .NE. 0)THEN 402 : MCHPO1 = IYC 403 : SEGACT MCHPO1 404 : MSOUP1 = MCHPO1.IPCHP(1) 405 : SEGDES MCHPO1 406 : SEGACT MSOUP1 407 : NESP = MSOUP1.NOCOMP(/2) 408 : MPYC = MSOUP1.IPOVAL 409 : SEGACT MPYC 410 : C 411 : MCHEL1 = IROF 412 : SEGINI, MCHEL2 = MCHEL1 413 : IYF = MCHEL2 414 : MCHEL2.TITCHE = 'Y ' 415 : N2 = NESP 416 : SEGINI MCHAMY 417 : MCHEL2.ICHAML(1) = MCHAMY 418 : SEGDES MCHEL2 419 : N1EL = NFAC 420 : N1PTEL = 3 421 : N2EL = 0 422 : N2PTEL = 0 423 : DO I1 = 1, NESP 424 : SEGINI MELVA1 425 : MCHAMY.IELVAL(I1) = MELVA1 426 : CARCEL = ' ' 427 : CARCEL(1:4) = MSOUP1.NOCOMP(I1) 428 : MCHAMY.NOMCHE(I1) = CARCEL 429 : MCHAMY.TYPCHE(I1) = 'REAL*8 ' 430 : ENDDO 431 : C 432 : SEGDES MSOUP1 433 : NMA = NESP 434 : SEGINI FRAMAS 435 : C 436 : C**** On laisse actives les segments pointes par 437 : C MPYC, MCHAMY,FRAMAS, et le MELVALs relatifs aux 438 : C fractions massiques 439 : C 440 : C 441 : ELSE 442 : IYF = 0 443 : NESP = 0 444 : ENDIF 445 : C 446 : C**** Les scalaires passifs: le CHPOINT et le relative CHAMELEM 447 : C 448 : IF(ISCAC .NE. 0)THEN 449 : MCHPO1 = ISCAC 450 : SEGACT MCHPO1 451 : MSOUP1 = MCHPO1.IPCHP(1) 452 : SEGDES MCHPO1 453 : SEGACT MSOUP1 454 : NSCA = MSOUP1.NOCOMP(/2) 455 : MPSC = MSOUP1.IPOVAL 456 : SEGACT MPSC 457 : C 458 : MCHEL1 = IROF 459 : SEGINI, MCHEL2 = MCHEL1 460 : ISCAF = MCHEL2 461 : MCHEL2.TITCHE = 'SCALPASS ' 462 : N2 = NSCA 463 : SEGINI MCHAMS 464 : MCHEL2.ICHAML(1) = MCHAMS 465 : SEGDES MCHEL2 466 : N1EL = NFAC 467 : N1PTEL = 3 468 : N2EL = 0 469 : N2PTEL = 0 470 : DO I1 = 1, NSCA 471 : SEGINI MELVA1 472 : MCHAMS.IELVAL(I1) = MELVA1 473 : CARCEL = ' ' 474 : CARCEL(1:4) = MSOUP1.NOCOMP(I1) 475 : MCHAMS.NOMCHE(I1) = CARCEL 476 : MCHAMS.TYPCHE(I1) = 'REAL*8 ' 477 : ENDDO 478 : C 479 : SEGDES MSOUP1 480 : NMA = NSCA 481 : SEGINI SCALPA 482 : C 483 : C**** On laisse actives les segments pointes par 484 : C MPYC, MCHAMY,FRAMAS, et le MELVALs relatifs aux 485 : C fractions massiques 486 : C 487 : C 488 : ELSE 489 : ISCAF = 0 490 : NSCA = 0 491 : ENDIF 492 : C 493 : C**** Recapitulatif 494 : C 495 : C MELVNX, MELVNY, MELVNZ 496 : C MELT1X, MELT1Y, MELT1Z 497 : C MELT2X, MELT2Y, MELT2Z 498 : C 499 : C MELVUN, MELVUT, MELVUV -> vitesse 500 : C 501 : C MELRO -> densite 502 : C 503 : C MELP -> pression 504 : C 505 : C MPROC -> densite 506 : C 507 : C MPVITC -> vitesse 508 : C 509 : C MPPC -> pression 510 : C 511 : C MPNORM -> normales aux faces 512 : C 513 : C**** Boucle sur le faces 514 : C 515 : DO NLCF = 1, NFAC 516 : C 517 : C******* NLCF = numero local du centre de face 518 : C NGCF = numero global du centre de face 519 : C NGCEG = numero global du centre ELT "gauche" 520 : C NLCEG = numero local du centre ELT "gauche" 521 : C NGCED = numero global du centre ELT "droite" 522 : C NLCED = numero local du centre ELT "droite" 523 : C 524 : NGCEG = IPT1.NUM(1,NLCF) 525 : NGCF = IPT1.NUM(2,NLCF) 526 : NGCED = IPT1.NUM(3,NLCF) 527 : NLCEG = MLENT1.LECT(NGCEG) 528 : NLCED = MLENT1.LECT(NGCED) 529 : C 530 : C******* TEST: IPT2.NUM(1,NLCF) = IPT1.NUM(2,NLCF) 531 : C 532 : NGCF1 = IPT2.NUM(1,NLCF) 533 : IF( NGCF1 .NE. NGCF) THEN 534 : LOGAN = .TRUE. 535 : MESERR(1:40) = 'PRET, subroutine pre312.eso ' 536 : GOTO 9999 537 : ENDIF 538 : C 539 : C******* Cosinus directeurs des NORMALES aux faces 540 : C 541 : C On impose que les normales sont direct "Gauche" -> "Centre" 542 : C 543 : INDCEL = (NGCEG-1)*(IDIM+1) 544 : XG = XCOOR(INDCEL+1) 545 : YG = XCOOR(INDCEL+2) 546 : ZG = XCOOR(INDCEL+3) 547 : INDCEL = (NGCF-1)*(IDIM+1) 548 : XC = XCOOR(INDCEL + 1) 549 : YC = XCOOR(INDCEL + 2) 550 : ZC = XCOOR(INDCEL+3) 551 : DXG = XC - XG 552 : DYG = YC - YG 553 : DZG = ZC - ZG 554 : 555 : C 556 : C******* On calcule le sign du pruduit scalare 557 : C (Normales de Castem) * (vecteur "gauche" -> "centre") 558 : C 559 : CNX = MPNORM.VPOCHA(NLCF,7) 560 : CNY = MPNORM.VPOCHA(NLCF,8) 561 : CNZ = MPNORM.VPOCHA(NLCF,9) 562 : ORIENT = CNX * DXG + CNY * DYG + CNZ * DZG 563 : ORIENT = SIGN(1.0D0,ORIENT) 564 : IF(ORIENT .NE. 1.0D0)THEN 565 : LOGAN = .TRUE. 566 : MESERR(1:30)= 567 : & 'PRET , subroutine pre312.eso. ' 568 : GOTO 9999 569 : ENDIF 570 : CNX = CNX * ORIENT 571 : CNY = CNY * ORIENT 572 : CNZ = CNZ * ORIENT 573 : C 574 : C********** Cosinus directeurs de tangente 1 575 : C 576 : CTX = MPNORM.VPOCHA(NLCF,1) * ORIENT 577 : CTY = MPNORM.VPOCHA(NLCF,2) * ORIENT 578 : CTZ = MPNORM.VPOCHA(NLCF,3) * ORIENT 579 : C 580 : C********** Cosinus directeurs de tangente 2 581 : C 582 : CVX = MPNORM.VPOCHA(NLCF,4) * ORIENT 583 : CVY = MPNORM.VPOCHA(NLCF,5) * ORIENT 584 : CVZ = MPNORM.VPOCHA(NLCF,6) * ORIENT 585 : C 586 : C 587 : C******* Les autres MELVALs 588 : C 589 : C 590 : C******* N.B.: On suppose qu'on a déjà controlle RO, P, > 0 591 : C Y \in (1,3) 592 : C 593 : C******* NGCEG = NGCED -> Mur 594 : C 595 : IF( NGCEG .EQ. NGCED)THEN 596 : ROG = MPROC.VPOCHA(NLCEG , 1) 597 : PG = MPPC.VPOCHA(NLCEG, 1) 598 : UXG = MPVITC.VPOCHA(NLCEG , 1) 599 : UYG = MPVITC.VPOCHA(NLCEG , 2) 600 : UZG = MPVITC.VPOCHA(NLCEG , 3) 601 : UNG = UXG * CNX + UYG * CNY + UZG * CNZ 602 : UTG = UXG * CTX + UYG * CTY + UZG * CTZ 603 : UVG = UXG * CVX + UYG * CVY + UZG * CVZ 604 : C 605 : C********** Son etat droite 606 : C 607 : ROD = ROG 608 : PD = PG 609 : UND = -1.0D0 * UNG 610 : UTD = UTG 611 : UVD = UVG 612 : C 613 : C********** Les fractiones massiques 614 : C 615 : DO I1 = 1, NESP, 1 616 : FRAMAS.FRAMG(I1) = MPYC.VPOCHA(NLCEG,I1) 617 : FRAMAS.FRAMD(I1) = FRAMAS.FRAMG(I1) 618 : ENDDO 619 : C 620 : C********** Les scalaires passifs 621 : C 622 : DO I1 = 1, NSCA, 1 623 : SCALPA.FRAMG(I1) = MPSC.VPOCHA(NLCEG,I1) 624 : SCALPA.FRAMD(I1) = SCALPA.FRAMG(I1) 625 : ENDDO 626 : C 627 : C************* Fin cas mur 628 : C 629 : ELSE 630 : C 631 : C************* Etat gauche 632 : C 633 : ROG = MPROC.VPOCHA(NLCEG, 1) 634 : PG = MPPC.VPOCHA(NLCEG, 1) 635 : UXG = MPVITC.VPOCHA(NLCEG , 1) 636 : UYG = MPVITC.VPOCHA(NLCEG , 2) 637 : UZG = MPVITC.VPOCHA(NLCEG , 3) 638 : UNG = UXG * CNX + UYG * CNY + UZG * CNZ 639 : UTG = UXG * CTX + UYG * CTY + UZG * CTZ 640 : UVG = UXG * CVX + UYG * CVY + UZG * CVZ 641 : C 642 : C********** Etat droit 643 : C 644 : ROD = MPROC.VPOCHA(NLCED,1) 645 : PD = MPPC.VPOCHA(NLCED,1) 646 : C 647 : C************* On suppose qu'on a déjà controlle ROG, PG > 0 648 : C Si non il faut le faire!!! 649 : C 650 : UXD = MPVITC.VPOCHA(NLCED,1) 651 : UYD = MPVITC.VPOCHA(NLCED,2) 652 : UZD = MPVITC.VPOCHA(NLCED,3) 653 : UND = UXD * CNX + UYD * CNY + UZD * CNZ 654 : UTD = UXD * CTX + UYD * CTY + UZD * CTZ 655 : UVD = UXD * CVX + UYD * CVY + UZD * CVZ 656 : C 657 : C********** Les fractions massiques 658 : C 659 : DO I1 = 1, NESP, 1 660 : FRAMAS.FRAMG(I1) = MPYC.VPOCHA(NLCEG,I1) 661 : FRAMAS.FRAMD(I1) = MPYC.VPOCHA(NLCED,I1) 662 : ENDDO 663 : C 664 : C********** Les scalaires passifs 665 : C 666 : DO I1 = 1, NSCA, 1 667 : SCALPA.FRAMG(I1) = MPSC.VPOCHA(NLCEG,I1) 668 : SCALPA.FRAMD(I1) = MPSC.VPOCHA(NLCED,I1) 669 : ENDDO 670 : ENDIF 671 : C 672 : C************* Les MELVALs 673 : C 674 : MELRO.VELCHE(1,NLCF) = ROG 675 : MELRO.VELCHE(3,NLCF) = ROD 676 : MELP.VELCHE(1,NLCF) = PG 677 : MELP.VELCHE(3,NLCF) = PD 678 : MELVUN.VELCHE(1,NLCF) = UNG 679 : MELVUN.VELCHE(3,NLCF) = UND 680 : MELVUT.VELCHE(1,NLCF) = UTG 681 : MELVUT.VELCHE(3,NLCF) = UTD 682 : MELVUV.VELCHE(1,NLCF) = UVG 683 : MELVUV.VELCHE(3,NLCF) = UVD 684 : MELVNX.VELCHE(1,NLCF) = CNX 685 : MELVNY.VELCHE(1,NLCF) = CNY 686 : MELVNZ.VELCHE(1,NLCF) = CNZ 687 : MELT1X.VELCHE(1,NLCF) = CTX 688 : MELT1Y.VELCHE(1,NLCF) = CTY 689 : MELT1Z.VELCHE(1,NLCF) = CTZ 690 : MELT2X.VELCHE(1,NLCF) = CVX 691 : MELT2Y.VELCHE(1,NLCF) = CVY 692 : MELT2Z.VELCHE(1,NLCF) = CVZ 693 : DO I1 = 1, NESP, 1 694 : MELVA1 = MCHAMY.IELVAL(I1) 695 : MELVA1.VELCHE(1,NLCF) = FRAMAS.FRAMG(I1) 696 : MELVA1.VELCHE(3,NLCF) = FRAMAS.FRAMD(I1) 697 : ENDDO 698 : DO I1 = 1, NSCA, 1 699 : MELVA1 = MCHAMS.IELVAL(I1) 700 : MELVA1.VELCHE(1,NLCF) = SCALPA.FRAMG(I1) 701 : MELVA1.VELCHE(3,NLCF) = SCALPA.FRAMD(I1) 702 : ENDDO 703 : ENDDO 704 : C 705 : C**** Desactivation des SEGMENTs 706 : C 707 : SEGDES IPT1 708 : SEGDES IPT2 709 : C 710 : SEGDES MPROC 711 : SEGDES MPVITC 712 : SEGDES MPPC 713 : SEGDES MPNORM 714 : C 715 : SEGDES MELRO 716 : SEGDES MELP 717 : SEGDES MELVUN 718 : SEGDES MELVUT 719 : SEGDES MELVUV 720 : SEGDES MELVNX 721 : SEGDES MELVNY 722 : SEGDES MELVNZ 723 : SEGDES MELT1X 724 : SEGDES MELT1Y 725 : SEGDES MELT1Z 726 : SEGDES MELT2X 727 : SEGDES MELT2Y 728 : SEGDES MELT2Z 729 : C 730 : IF(NESP .GT. 0)THEN 731 : SEGDES MPYC 732 : DO I1 = 1, NESP 733 : MELVA1 = MCHAMY.IELVAL(I1) 734 : SEGDES MELVA1 735 : ENDDO 736 : SEGDES MCHAMY 737 : SEGSUP FRAMAS 738 : ENDIF 739 : IF(NSCA .GT. 0)THEN 740 : SEGDES MPSC 741 : DO I1 = 1, NSCA 742 : MELVA1 = MCHAMS.IELVAL(I1) 743 : SEGDES MELVA1 744 : ENDDO 745 : SEGDES MCHAMS 746 : SEGSUP SCALPA 747 : ENDIF 748 : C 749 : C**** Destruction du MELNTI correspondance local/global 750 : C 751 : SEGSUP MLENT1 752 : C 753 : 9999 CONTINUE 754 : C 755 : RETURN 756 : END 757 : 758 : 759 : 760 : 761 : 762 : 763 : 764 : 765 : 766 : 767 :
© Cast3M 2003 - All rights reserved.
Disclaimer