1 : C PRE311 SOURCE PV 09/03/12 21:30:52 6325 2 : SUBROUTINE PRE311(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 : PRE311 11 : C 12 : C DESCRIPTION : Voir PRE31 13 : C 14 : C Cas Deux 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 ; 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 SORTIES 69 : C 70 : C 71 : C IROF : MCHAML defini sur le MELEME de pointeur IFACEL, 72 : C contenant la masse volumique RHO 73 : C 74 : C IVITF : MCHAML defini sur le MELEME de pointeur IFACEL, 75 : C contenant la vitesse UN, UT dans le repaire local 76 : C (n,t) et defini sur le MELEME de pointeur IFACE, 77 : C contenant les cosinus directeurs du repere local 78 : C 79 : C IPF : MCHAML defini sur le MELEME de pointeur IFACEL, 80 : C contenant la pression P 81 : C 82 : C IYF : MCHAML defini sur le MELEME de pointeur IFACEL, 83 : C contenant les fractions massiques (ou 0 dans le cas 84 : C monoespece); 85 : C 86 : C ISCAF : MCHAML defini sur le MELEME de pointeur IFACEL, 87 : C contenant les scalaire passifs (ou 0) 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 Y 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 18.12.98. 111 : C 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, ISCAC, INORM 142 : & , IROF, IVITF, IPF, IYF, NESP, 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 : REAL*8 VALER, VAL1, VAL2, XG, YG, XC, YC, DXG, DYG 147 : & , CNX, CNY, CTX, CTY, ORIENT 148 : & , ROG, PG, UXG, UYG, UNG, UTG 149 : & , ROD, PD, UXD, UYD, UND, UTD 150 : CHARACTER*(40) MESERR 151 : CHARACTER*(8) TYPE, CARCEL 152 : LOGICAL LOGAN,LOGNEG, LOGBOR 153 : C 154 : C**** Les Includes 155 : C 156 : -INC SMCOORD 157 : -INC CCOPTIO 158 : -INC SMCHPOI 159 : POINTEUR MPROC.MPOVAL, MPVITC.MPOVAL, MPPC.MPOVAL, 160 : & MPNORM.MPOVAL, MPYC.MPOVAL, MPSC.MPOVAL 161 : -INC SMCHAML 162 : POINTEUR MELVNX.MELVAL, MELVNY.MELVAL, 163 : & MELT1X.MELVAL, MELT1Y.MELVAL 164 : POINTEUR MELVUN.MELVAL, MELVUT.MELVAL 165 : POINTEUR MELRO.MELVAL, MELP.MELVAL 166 : POINTEUR MCHAMY.MCHAML, MCHAMS.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(NMA), FRAMD(NMA) 174 : ENDSEGMENT 175 : POINTEUR SCALPA.FRAMAS 176 : C 177 : C**** Initialisation des parametres d'erreur déjà faite, i.e. 178 : C 179 : C LOGNEG = .FALSE. 180 : C LOGBOR = .FALSE. 181 : C MESERR = ' ' 182 : C MOTERR(1:40) = MESERR(1:40) 183 : C VALER = 0.0D0 184 : C VAL1 = 0.0D0 185 : C VAL2 = 0.0D0 186 : C 187 : C 188 : C**** KRIPAD pour la correspondance global/local de centre 189 : C 189 : CALL KRIPAD(ICEN,MLENT1) 190 : C 191 : C**** MLENTI1 a MCORD.XCOORD(/1)/(IDIM+1) elements 192 : C 193 : C Si i est le numero global d'un noeud de ICEN, 194 : C MLENT1.LECT(i) contient sa position, i.e. 195 : C 196 : C I = numero global du noeud centre 197 : C MLENT1.LECT(i) = numero local du noeud centre 198 : C 199 : C MLENT1 déjà activé, i.e. 200 : C 201 : C SEGACT MLENT1 202 : C 203 : C**** Activation de CHPOINTs 204 : C 205 : C densité 206 : C vitesse 207 : C pression 208 : C cosinus directeurs des normales aux surface 209 : C 209 : CALL LICHT(IROC ,MPROC ,TYPE,IGEOM) 209 : CALL LICHT(IVITC,MPVITC,TYPE,IGEOM) 209 : CALL LICHT(IPC ,MPPC ,TYPE,IGEOM) 209 : CALL LICHT(INORM,MPNORM,TYPE,IGEOM) 210 : C 211 : C**** MPOVA1 - MPOVA5 sont déjà activés i.e.: 212 : C 213 : C SEGACT MPROC 214 : C SEGACT MPVITC 215 : C SEGACT MPPC 216 : C SEGACT MPNORM 217 : C 218 : C 219 : C**** Le MELEME FACEL 220 : C 221 : IPT1 = IFACEL 222 : IPT2 = IFACE 223 : SEGACT IPT1 224 : SEGACT IPT2 225 : NFAC = IPT1.NUM(/2) 226 : C 227 : C**** Creation de MCHAMLs contenant les etats gauche et droite, 228 : C 229 : C i.e.: 230 : C 231 : C vitesse + cosinus directors du repere local 232 : C densité 233 : C pression 234 : C fractions massiques 235 : C 236 : C**** Cosinus directors du repere local et vitesse 237 : C 238 : C Les cosinus directeurs 239 : C 240 : N1 = 2 241 : N3 = 6 242 : L1 = 28 243 : SEGINI MCHEL1 244 : IVITF = MCHEL1 245 : MCHEL1.TITCHE = 'U ' 246 : MCHEL1.IMACHE(1) = IFACE 247 : MCHEL1.IMACHE(2) = IFACEL 248 : MCHEL1.CONCHE(1) = ' (n,t) in (x,y) ' 249 : MCHEL1.CONCHE(2) = ' U in (n,t) ' 250 : C 251 : C**** Valeurs des cosinus definies par respect au repair global, i.e. 252 : C 253 : MCHEL1.INFCHE(1,1) = 2 254 : MCHEL1.INFCHE(1,3) = NIFOUR 255 : MCHEL1.INFCHE(1,4) = 0 256 : MCHEL1.INFCHE(1,5) = 0 257 : MCHEL1.INFCHE(1,6) = 0 258 : MCHEL1.IFOCHE = IFOUR 259 : C 260 : C**** Valeurs de vitesse definies par respect au repair local, i.e. 261 : C 262 : MCHEL1.INFCHE(2,1) = 1 263 : MCHEL1.INFCHE(2,3) = NIFOUR 264 : MCHEL1.INFCHE(2,4) = 0 265 : MCHEL1.INFCHE(2,5) = 0 266 : MCHEL1.INFCHE(2,6) = 0 267 : C 268 : C**** Le cosinus directeurs 269 : C 270 : N1PTEL = 1 271 : N1EL = NFAC 272 : N2PTEL = 0 273 : N2EL = 0 274 : C 275 : C**** MCHAML a N2 composantes: 276 : C 277 : C cosinus directeurs du repere local (n,t1) 278 : C 279 : C IDIM = 2 -> 4 composantes 280 : C 281 : N2 = 4 282 : SEGINI MCHAM1 283 : MCHEL1.ICHAML(1) = MCHAM1 284 : MCHAM1.NOMCHE(1) = 'NX ' 285 : MCHAM1.NOMCHE(2) = 'NY ' 286 : MCHAM1.NOMCHE(3) = 'TX ' 287 : MCHAM1.NOMCHE(4) = 'TY ' 288 : MCHAM1.TYPCHE(1) = 'REAL*8 ' 289 : MCHAM1.TYPCHE(2) = 'REAL*8 ' 290 : MCHAM1.TYPCHE(3) = 'REAL*8 ' 291 : MCHAM1.TYPCHE(4) = 'REAL*8 ' 292 : SEGINI MELVNX 293 : SEGINI MELVNY 294 : SEGINI MELT1X 295 : SEGINI MELT1Y 296 : MCHAM1.IELVAL(1) = MELVNX 297 : MCHAM1.IELVAL(2) = MELVNY 298 : MCHAM1.IELVAL(3) = MELT1X 299 : MCHAM1.IELVAL(4) = MELT1Y 300 : SEGDES MCHAM1 301 : C 302 : C**** Vitesse 303 : C 304 : N1EL = NFAC 305 : N1PTEL = 3 306 : N2EL = 0 307 : N2PTEL = 0 308 : C 309 : C**** MCHAML a N2 composantes: 310 : C 311 : C IDIM = 2 -> 2 composantes 312 : C 313 : N2 = 2 314 : SEGINI MCHAM1 315 : MCHEL1.ICHAML(2) = MCHAM1 316 : SEGDES MCHEL1 317 : MCHAM1.NOMCHE(1) = 'UN ' 318 : MCHAM1.NOMCHE(2) = 'UT ' 319 : MCHAM1.TYPCHE(1) = 'REAL*8 ' 320 : MCHAM1.TYPCHE(2) = 'REAL*8 ' 321 : SEGINI MELVUN 322 : SEGINI MELVUT 323 : MCHAM1.IELVAL(1) = MELVUN 324 : MCHAM1.IELVAL(2) = MELVUT 325 : SEGDES MCHAM1 326 : C 327 : C**** Densite 328 : C 329 : N1 = 1 330 : N3 = 6 331 : L1 = 15 332 : SEGINI MCHEL2 333 : IROF = MCHEL2 334 : MCHEL2.IMACHE(1) = IFACEL 335 : MCHEL2.TITCHE = 'RO ' 336 : MCHEL2.CONCHE(1) = ' ' 337 : C 338 : C**** Valeurs independente du repére, i.e. 339 : C 340 : MCHEL2.INFCHE(1,1) = 0 341 : MCHEL2.INFCHE(1,3) = NIFOUR 342 : MCHEL2.INFCHE(1,4) = 0 343 : MCHEL2.INFCHE(1,5) = 0 344 : MCHEL2.INFCHE(1,6) = 0 345 : MCHEL2.IFOCHE = IFOUR 346 : N2 = 1 347 : SEGINI MCHAM1 348 : MCHEL2.ICHAML(1) = MCHAM1 349 : SEGDES MCHEL2 350 : MCHAM1.NOMCHE(1) = 'SCAL ' 351 : MCHAM1.TYPCHE(1) = 'REAL*8 ' 352 : SEGINI MELRO 353 : MCHAM1.IELVAL(1) = MELRO 354 : SEGDES MCHAM1 355 : C 356 : C**** Pression 357 : C 358 : MCHEL1 = IROF 359 : SEGINI, MCHEL2 = MCHEL1 360 : IPF = MCHEL2 361 : MCHEL2.TITCHE = 'P ' 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 MELP 369 : MCHAM2.IELVAL(1) = MELP 370 : SEGDES MCHAM2 371 : C 372 : C**** Les fractions massiques: le CHPOINT et le relative CHAMELEM 373 : C 374 : IF(IYC .NE. 0)THEN 375 : MCHPO1 = IYC 376 : SEGACT MCHPO1 377 : MSOUP1 = MCHPO1.IPCHP(1) 378 : SEGDES MCHPO1 379 : SEGACT MSOUP1 380 : NESP = MSOUP1.NOCOMP(/2) 381 : MPYC = MSOUP1.IPOVAL 382 : SEGACT MPYC 383 : C 384 : MCHEL1 = IROF 385 : SEGINI, MCHEL2 = MCHEL1 386 : IYF = MCHEL2 387 : MCHEL2.TITCHE = 'Y ' 388 : N2 = NESP 389 : SEGINI MCHAMY 390 : MCHEL2.ICHAML(1) = MCHAMY 391 : SEGDES MCHEL2 392 : N1EL = NFAC 393 : N1PTEL = 3 394 : N2EL = 0 395 : N2PTEL = 0 396 : DO I1 = 1, NESP 397 : SEGINI MELVA1 398 : MCHAMY.IELVAL(I1) = MELVA1 399 : CARCEL = ' ' 400 : CARCEL(1:4) = MSOUP1.NOCOMP(I1) 401 : MCHAMY.NOMCHE(I1) = CARCEL 402 : MCHAMY.TYPCHE(I1) = 'REAL*8 ' 403 : ENDDO 404 : C 405 : SEGDES MSOUP1 406 : NMA = NESP 407 : SEGINI FRAMAS 408 : ELSE 409 : IYF = 0 410 : NESP = 0 411 : ENDIF 412 : C 413 : C**** Les scalaires passifs: le CHPOINT et le relative CHAMELEM 414 : C 415 : IF(ISCAC .NE. 0)THEN 416 : MCHPO1 = ISCAC 417 : SEGACT MCHPO1 418 : MSOUP1 = MCHPO1.IPCHP(1) 419 : SEGDES MCHPO1 420 : SEGACT MSOUP1 421 : NSCA = MSOUP1.NOCOMP(/2) 422 : MPSC = MSOUP1.IPOVAL 423 : SEGACT MPSC 424 : C 425 : MCHEL1 = IROF 426 : SEGINI, MCHEL2 = MCHEL1 427 : ISCAF = MCHEL2 428 : MCHEL2.TITCHE = 'SCALPASS ' 429 : N2 = NSCA 430 : SEGINI MCHAMS 431 : MCHEL2.ICHAML(1) = MCHAMS 432 : SEGDES MCHEL2 433 : N1EL = NFAC 434 : N1PTEL = 3 435 : N2EL = 0 436 : N2PTEL = 0 437 : DO I1 = 1, NSCA 438 : SEGINI MELVA1 439 : MCHAMS.IELVAL(I1) = MELVA1 440 : CARCEL = ' ' 441 : CARCEL(1:4) = MSOUP1.NOCOMP(I1) 442 : MCHAMS.NOMCHE(I1) = CARCEL 443 : MCHAMS.TYPCHE(I1) = 'REAL*8 ' 444 : ENDDO 445 : C 446 : SEGDES MSOUP1 447 : NMA = NSCA 448 : SEGINI SCALPA 449 : C 450 : C**** On laisse actives les segments pointes par 451 : C MPYC, MCHAMY,FRAMAS, et le MELVALs relatifs aux 452 : C fractions massiques 453 : C 454 : C 455 : ELSE 456 : ISCAF = 0 457 : NSCA = 0 458 : ENDIF 459 : C 460 : C**** Recapitulatif 461 : C 462 : C MELVNX, MELVNY 463 : C MELT1X, MELT1Y -> normales et tangentes aux faces 464 : C 465 : C MELVUN, MELVUT -> vitesse 466 : C 467 : C MELRO -> densite 468 : C 469 : C MELP -> pression 470 : C 471 : C MPROC -> densite 472 : C 473 : C MPVITC -> vitesse 474 : C 475 : C MPPC -> pression 476 : C 477 : C MPNORM -> normales aux faces 478 : C 479 : C**** Boucle sur le faces 480 : C 481 : DO NLCF = 1, NFAC 482 : C 483 : C******* NLCF = numero local du centre de face 484 : C NGCF = numero global du centre de face 485 : C NGCEG = numero global du centre ELT "gauche" 486 : C NLCEG = numero local du centre ELT "gauche" 487 : C NGCED = numero global du centre ELT "droite" 488 : C NLCED = numero local du centre ELT "droite" 489 : C 490 : NGCEG = IPT1.NUM(1,NLCF) 491 : NGCF = IPT1.NUM(2,NLCF) 492 : NGCED = IPT1.NUM(3,NLCF) 493 : NLCEG = MLENT1.LECT(NGCEG) 494 : NLCED = MLENT1.LECT(NGCED) 495 : C 496 : C******* TEST: IPT2.NUM(1,NLCF) = IPT1.NUM(2,NLCF) 497 : C 498 : NGCF1 = IPT2.NUM(1,NLCF) 499 : IF( NGCF1 .NE. NGCF) THEN 500 : LOGAN = .TRUE. 501 : MESERR(1:40) = 'PRET, subroutine pre311.eso ' 502 : GOTO 9999 503 : ENDIF 504 : C 505 : C******* Cosinus directeurs des NORMALES aux faces 506 : C 507 : C On impose que les normales sont direct "Gauche" -> "Centre" 508 : C 509 : XG = XCOOR((NGCEG-1)*(IDIM+1)+1) 510 : YG = XCOOR((NGCEG-1)*(IDIM+1)+2) 511 : XC = XCOOR((NGCF-1)*(IDIM+1)+1) 512 : YC = XCOOR((NGCF-1)*(IDIM+1)+2) 513 : DXG = XC - XG 514 : DYG = YC - YG 515 : 516 : C 517 : C******* On calcule le sign du pruduit scalare 518 : C (Normales de Castem) * (vecteur "gauche" -> "centre") 519 : C 520 : CNX = MPNORM.VPOCHA(NLCF,1) 521 : CNY = MPNORM.VPOCHA(NLCF,2) 522 : ORIENT = CNX * DXG + CNY * DYG 523 : ORIENT = SIGN(1.0D0,ORIENT) 524 : IF(ORIENT .NE. 1.0D0)THEN 525 : LOGAN = .TRUE. 526 : MESERR(1:30)= 527 : & 'PRET , subroutine pre311.eso. ' 528 : GOTO 9999 529 : ENDIF 530 : CNX = CNX * ORIENT 531 : CNY = CNY * ORIENT 532 : C 533 : C********** Cosinus directeurs de tangent 2D 534 : C 535 : CTX = -1.0D0 * CNY 536 : CTY = CNX 537 : C 538 : C 539 : C******* Les autres MELVALs 540 : C 541 : C 542 : C******* N.B.: On suppose qu'on a déjà controlle RO, P, > 0 543 : C Y \in (1,3) 544 : C 545 : C******* NGCEG = NGCED -> Mur 546 : C 547 : IF( NGCEG .EQ. NGCED)THEN 548 : ROG = MPROC.VPOCHA(NLCEG , 1) 549 : PG = MPPC.VPOCHA(NLCEG, 1) 550 : UXG = MPVITC.VPOCHA(NLCEG , 1) 551 : UYG = MPVITC.VPOCHA(NLCEG , 2) 552 : UNG = UXG * CNX + UYG * CNY 553 : UTG = UXG * CTX + UYG * CTY 554 : C 555 : C********** Son etat droite 556 : C 557 : ROD = ROG 558 : PD = PG 559 : UND = -1.0D0 * UNG 560 : UTD = UTG 561 : C 562 : C********** Les fractiones massiques 563 : C 564 : DO I1 = 1, NESP, 1 565 : FRAMAS.FRAMG(I1) = MPYC.VPOCHA(NLCEG,I1) 566 : FRAMAS.FRAMD(I1) = FRAMAS.FRAMG(I1) 567 : ENDDO 568 : C 569 : C********** Les scalaires passifs 570 : C 571 : DO I1 = 1, NSCA, 1 572 : SCALPA.FRAMG(I1) = MPSC.VPOCHA(NLCEG,I1) 573 : SCALPA.FRAMD(I1) = SCALPA.FRAMG(I1) 574 : ENDDO 575 : C 576 : C************* Fin cas mur 577 : C 578 : ELSE 579 : C 580 : C************* Etat gauche 581 : C 582 : ROG = MPROC.VPOCHA(NLCEG, 1) 583 : PG = MPPC.VPOCHA(NLCEG, 1) 584 : UXG = MPVITC.VPOCHA(NLCEG , 1) 585 : UYG = MPVITC.VPOCHA(NLCEG , 2) 586 : UNG = UXG * CNX + UYG * CNY 587 : UTG = UXG * CTX + UYG * CTY 588 : C 589 : C********** Etat droit 590 : C 591 : ROD = MPROC.VPOCHA(NLCED,1) 592 : PD = MPPC.VPOCHA(NLCED,1) 593 : C 594 : C************* On suppose qu'on a déjà controlle ROG, PG > 0 595 : C Si non il faut le faire!!! 596 : C 597 : UXD = MPVITC.VPOCHA(NLCED,1) 598 : UYD = MPVITC.VPOCHA(NLCED,2) 599 : UND = UXD * CNX + UYD * CNY 600 : UTD = UXD * CTX + UYD * CTY 601 : C 602 : C********** Les fractions massiques 603 : C 604 : DO I1 = 1, NESP, 1 605 : FRAMAS.FRAMG(I1) = MPYC.VPOCHA(NLCEG,I1) 606 : FRAMAS.FRAMD(I1) = MPYC.VPOCHA(NLCED,I1) 607 : ENDDO 608 : C 609 : C********** Les scalaires passifs 610 : C 611 : DO I1 = 1, NSCA, 1 612 : SCALPA.FRAMG(I1) = MPSC.VPOCHA(NLCEG,I1) 613 : SCALPA.FRAMD(I1) = MPSC.VPOCHA(NLCED,I1) 614 : ENDDO 615 : ENDIF 616 : C 617 : C************* Les MELVALs 618 : C 619 : MELRO.VELCHE(1,NLCF) = ROG 620 : MELRO.VELCHE(3,NLCF) = ROD 621 : MELP.VELCHE(1,NLCF) = PG 622 : MELP.VELCHE(3,NLCF) = PD 623 : MELVUN.VELCHE(1,NLCF) = UNG 624 : MELVUN.VELCHE(3,NLCF) = UND 625 : MELVUT.VELCHE(1,NLCF) = UTG 626 : MELVUT.VELCHE(3,NLCF) = UTD 627 : MELVNX.VELCHE(1,NLCF) = CNX 628 : MELVNY.VELCHE(1,NLCF) = CNY 629 : MELT1X.VELCHE(1,NLCF) = CTX 630 : MELT1Y.VELCHE(1,NLCF) = CTY 631 : DO I1 = 1, NESP, 1 632 : MELVA1 = MCHAMY.IELVAL(I1) 633 : MELVA1.VELCHE(1,NLCF) = FRAMAS.FRAMG(I1) 634 : MELVA1.VELCHE(3,NLCF) = FRAMAS.FRAMD(I1) 635 : ENDDO 636 : DO I1 = 1, NSCA, 1 637 : MELVA1 = MCHAMS.IELVAL(I1) 638 : MELVA1.VELCHE(1,NLCF) = SCALPA.FRAMG(I1) 639 : MELVA1.VELCHE(3,NLCF) = SCALPA.FRAMD(I1) 640 : ENDDO 641 : ENDDO 642 : C 643 : C**** Desactivation des SEGMENTs 644 : C 645 : SEGDES IPT1 646 : SEGDES IPT2 647 : C 648 : SEGDES MPROC 649 : SEGDES MPVITC 650 : SEGDES MPPC 651 : SEGDES MPNORM 652 : C 653 : SEGDES MELRO 654 : SEGDES MELP 655 : SEGDES MELVUN 656 : SEGDES MELVUT 657 : SEGDES MELVNX 658 : SEGDES MELVNY 659 : SEGDES MELT1X 660 : SEGDES MELT1Y 661 : C 662 : IF(NESP .GT. 0)THEN 663 : SEGDES MPYC 664 : DO I1 = 1, NESP 665 : MELVA1 = MCHAMY.IELVAL(I1) 666 : SEGDES MELVA1 667 : ENDDO 668 : SEGDES MCHAMY 669 : SEGSUP FRAMAS 670 : ENDIF 671 : IF(NSCA .GT. 0)THEN 672 : SEGDES MPSC 673 : DO I1 = 1, NSCA 674 : MELVA1 = MCHAMS.IELVAL(I1) 675 : SEGDES MELVA1 676 : ENDDO 677 : SEGDES MCHAMS 678 : SEGSUP SCALPA 679 : ENDIF 680 : C 681 : C**** Destruction du MELNTI correspondance local/global 682 : C 683 : SEGSUP MLENT1 684 : C 685 : 9999 CONTINUE 686 : C 687 : RETURN 688 : END 689 : 690 : 691 : 692 : 693 : 694 : 695 : 696 : 697 : 698 :
© Cast3M 2003 - All rights reserved.
Disclaimer