1 : C PRE222 SOURCE BECC 10/10/07 21:15:11 6774 2 : C PRE221 SOURCE BECC 98/08/24 21:21:08 3286 3 : SUBROUTINE PRE222(LOGTEM, 4 : & ICEN,IFACE,IFACEL,INORM, 5 : & IROC, IGRROC, IALROC, 6 : & IVITC, IGRVC, IALVC, 7 : & IPC ,IGRPC, IALPC, 8 : & MLRECV, MLRECP, MLMOT1, 9 : & IYC ,IGRYC, IALYC, 10 : & IGAMC, 11 : & DELTAT, 12 : & IROF,IVITF,IPF,IGAMF,IYF, 13 : & LOGAN,LOGNEG,LOGBOR,MESERR,VALER,VAL1,VAL2) 14 : C************************************************************************ 15 : C 16 : C PROJET : CASTEM 2000 17 : C 18 : C NOM : PRE221 19 : C 20 : C DESCRIPTION : Voir PRE22 21 : C 22 : C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI) 23 : C 24 : C AUTEUR : A. BECCANTINI, DRN/DMT/SEMT/TTMF 25 : C 26 : C************************************************************************ 27 : C 28 : C 29 : C APPELES (Outils) : KRIPAD, LICHT 30 : C 31 : C APPELES (Calcul) : AUCUN 32 : C 33 : C 34 : C************************************************************************ 35 : C 36 : C ENTREES 37 : C 38 : C LOGTEM : LOGICAL; si .TRUE. 2em ordre en temps 39 : C sinon 1er ordre en temps 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) Autres pointeurs 57 : C 58 : C IROC : CHPOINT "CENTRE" contenant la masse volumique RHO 59 : C 60 : C IGRROC : CHPOINT "CENTRE" contenant le gradient de la 61 : C masse volumique RHO (2 composantes) 62 : C 63 : C IALROC : CHPOINT "CENTRE" contenant le limiteur du gradient 64 : C de la masse volumique 65 : C 66 : C IVITC : CHPOINT "CENTRE" contenant la vitesse UX, UY ; 67 : C 68 : C IGRVC : CHPOINT "CENTRE" contenant le gradient de la 69 : C vitesse (4 composantes) 70 : C 71 : C IALVC : CHPOINT "CENTRE" contenant le limiteur du gradient 72 : C de la vitesse (2 composantes) 73 : C 74 : C IPC : CHPOINT "CENTRE" contenat la pression P; 75 : C 76 : C IGRPC : CHPOINT "CENTRE" contenant le gradient de la 77 : C pression (2 composantes) 78 : C 79 : C IALPC : CHPOINT "CENTRE" contenant le limiteur du gradient 80 : C de la pression 81 : C 82 : C MLRECV : pointeur de la LISTREEL des cv 83 : C 84 : C MLRECP : pointeur de la LISTREEL des cp 85 : C 86 : C MLMOT1 : pointeur des noms des gaz qui apparessent dans les 87 : C equations d'Euler 88 : C 89 : C IYC : CHPOINT "CENTRE" contenat les fractions massiques ; 90 : C 91 : C IGRYC : CHPOINT "CENTRE" contenant les gradient des fr.mass.; 92 : C 93 : C IALPC : CHPOINT "CENTRE" contenant les limiteurs des gradients 94 : C des fr.mass.; 95 : C 96 : C IGAMC : CHPOINT "CENTRE" contenat le "Gamma" du gaz 97 : C 98 : C 3) 99 : C 100 : C DELTAT : REAL*8, encrement en temps pour calculer la prediction 101 : C 102 : C 103 : C SORTIES 104 : C 105 : C 106 : C IROF : MCHAML defini sur le MELEME de pointeur IFACEL, 107 : C contenant la masse volumique RHO 108 : C 109 : C IVITF : MCHAML defini sur le MELEME de pointeur IFACEL, 110 : C contenant la vitesse UN, UT dans le repaire local 111 : C (n,t) et defini sur le MELEME de pointeur IFACE, 112 : C contenant les cosinus directeurs du repere local 113 : C 114 : C IPF : MCHAML defini sur le MELEME de pointeur IFACEL, 115 : C contenant la pression P 116 : C 117 : C IYF : MCHAML defini sur le MELEME de pointeur IFACEL, 118 : C contenant les fractions massiques; 119 : C 120 : C IGAMF : MCHAML defini sur le MELEME de pointeur IFACEL, 121 : C contenant le "gamma" du gaz 122 : C 123 : C LOGAN : anomalie detectee 124 : C 125 : C LOGNEG : (LOGICAL): si .TRUE. une pression ou une densité 126 : C negative a été detectée -> en interactif le 127 : C programme s'arrete en GIBIANE 128 : C (erreur stocké en MESERR et VALER) 129 : C 130 : C LOGBOR : (LOGICAL): si .TRUE. un gamma a ete detecte 131 : C dehor 1 et 3 (sa valeur stockée en MESERR et VALER; 132 : C en VAL1 et en VAL2 on stocke 1.0 et 3.0) 133 : C 134 : C MESERR 135 : C VALER 136 : C VAL1, 137 : C VAL2 : pour les messages d'erreur 138 : C 139 : C************************************************************************ 140 : C 141 : C HISTORIQUE (Anomalies et modifications éventuelles) 142 : C 143 : C HISTORIQUE : Créée le 10.7.98. 144 : C 145 : C************************************************************************ 146 : C 147 : C 148 : C ATTENTION: Cet programme marche si le MAILLAGE est convex; 149 : C si non il faut changer l'algoritme de calcul de 150 : C l'orientation des normales aux faces. 151 : C 152 : C La positivité n'est pas controlle parce que c'est déjà fait 153 : C dans l'operateur PRIM 154 : C 155 : C 156 : C************************************************************************ 157 : C 158 : C**** Variables de COOPTIO 159 : C 160 : C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR 161 : C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ 162 : C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES 163 : C & ,IECHO, IIMPI, IOSPI 164 : C & ,IDIM 165 : CC & ,MCOORD 166 : C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE 167 : C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU 168 : C & ,NORINC,NORVAL,NORIND,NORVAD 169 : C & ,NUCROU, IPSAUV 170 : C 171 : C**** Les variables 172 : C 173 : IMPLICIT INTEGER(I-N) 174 : INTEGER ICEN, IFACE, IFACEL, INORM,IROC, IGRROC, IALROC 175 : & , IVITC, IGRVC, IALVC 176 : & , IPC ,IGRPC, IALPC 177 : & , IYC, IGRYC, IALYC 178 : & , IGAMC 179 : & , IROF, IVITF, IPF, IGAMF, IYF 180 : & , IGEOM, NFAC, NCEN 181 : & , N1PTEL, N1EL, N2PTEL, N2EL, N2, N1, N3, L1, NLCE 182 : & , NLCF, NGCF, NGCEG, NLCEG, NGCED, NLCED, NGCF1 183 : & , IDIMP1, INDCEL, I1, NESP 184 : REAL*8 VALER, VAL1, VAL2, XG, YG, ZG, XC, YC, ZC, XD, YD, ZD, 185 : & DELTAT 186 : & ,DXG, DYG, DZG, DXD, DYD, DZD,ORIENT 187 : & , CNX, CNY, CNZ, CTX, CTY, CTZ, CVX, CVY, CVZ 188 : & , ROG, PG, GAMG, UXG, UYG, UZG, UNG, UTG, UVG 189 : & , ROD, PD, GAMD, UXD, UYD, UZD, UND, UTD, UVD 190 : & , VALCEL, DCEL, ALCEL 191 : & , DROX, DROY, DROZ, DUXX, DUXY, DUXZ, DUYX, DUYY, 192 : & DUYZ, DUZX, DUZY, DUZZ, DPX, DPY, DPZ 193 : & , DRO, DUX, DUY, DUZ, DP 194 : & , ALPHA, CPCEL, CVCEL, DYMAS, SUMY 195 : CHARACTER*(40) MESERR 196 : CHARACTER*(8) TYPE 197 : CHARACTER*(4) CARCEL 198 : LOGICAL LOGAN,LOGNEG, LOGBOR, LOGTEM, LOGI1, LOGI2 199 : C 200 : C**** Les Includes 201 : C 202 : -INC SMCOORD 203 : -INC CCOPTIO 204 : -INC SMCHPOI 205 : POINTEUR MPROC.MPOVAL, MPGRR.MPOVAL, 206 : & MPVITC.MPOVAL, MPGRV.MPOVAL, 207 : & MPPC.MPOVAL, MPGRP.MPOVAL, 208 : & MPYC.MPOVAL, MPGRY.MPOVAL, 209 : & MPGAMC.MPOVAL, MPNORM.MPOVAL, 210 : & MPROP.MPOVAL, MPPP.MPOVAL, MPVITP.MPOVAL, 211 : & MPYP.MPOVAL 212 : -INC SMCHAML 213 : POINTEUR MCHAMY.MCHAML 214 : POINTEUR MELVNX.MELVAL, MELVNY.MELVAL, MELVNZ.MELVAL, 215 : & MELT1X.MELVAL, MELT1Y.MELVAL, MELT1Z.MELVAL, 216 : & MELT2X.MELVAL, MELT2Y.MELVAL, MELT2Z.MELVAL 217 : POINTEUR MELVUN.MELVAL, MELVUT.MELVAL, MELVUV.MELVAL 218 : POINTEUR MELRO.MELVAL, MELP.MELVAL, 219 : & MELGAM.MELVAL 220 : POINTEUR MELALR.MPOVAL, 221 : & MELALV.MPOVAL, 222 : & MELALP.MPOVAL, 223 : & MELALY.MPOVAL 224 : -INC SMLENTI 225 : -INC SMELEME 226 : -INC SMLREEL 227 : POINTEUR MLRECV.MLREEL, MLRECP.MLREEL 228 : -INC SMLMOTS 229 : C 230 : C**** Segments des fractions massiques gauche et droit 231 : C 232 : SEGMENT FRAMAS 233 : REAL*8 FRAMG(NESP), FRAMD(NESP) 234 : ENDSEGMENT 235 : C 236 : SEGACT MLMOT1 237 : C 238 : C**** Initialisation des parametres d'erreur déjà faite, i.e. 239 : C 240 : C LOGNEG = .FALSE. 241 : C LOGBOR = .FALSE. 242 : C MESERR = ' ' 243 : C MOTERR(1:40) = MESERR(1:40) 244 : C VALER = 0.0D0 245 : C VAL1 = 0.0D0 246 : C VAL2 = 0.0D0 247 : C 248 : C AB 249 : C 2010/09/14: LOGI1 computed can destroy the symmetry! 250 : C LOGI1 = .FALSE. 251 : LOGI1 = .FALSE. 252 : C 253 : C**** KRIPAD pour la correspondance global/local de centre 254 : C 254 : CALL KRIPAD(ICEN,MLENT1) 255 : C 256 : C**** MLENTI1 a MCORD.XCOORD(/1)/(IDIM+1) elements 257 : C 258 : C Si i est le numero global d'un noeud de ICEN, 259 : C MLENT1.LECT(i) contient sa position, i.e. 260 : C 261 : C I = numero global du noeud centre 262 : C MLENT1.LECT(i) = numero local du noeud centre 263 : C 264 : C MLENT1 déjà activé, i.e. 265 : C 266 : C SEGACT MLENT1 267 : C 268 : C**** Activation de CHPOINTs 269 : C 270 : C densité + grad + limiteur 271 : C vitesse + grad + limiteur 272 : C pression + grad + limiteur 273 : C fract.mass + grad + limiteur 274 : C gamma 275 : C cosinus directeurs des normales aux surface 276 : C 276 : CALL LICHT(IROC , MPROC , TYPE, IGEOM) 276 : CALL LICHT(IGRROC, MPGRR , TYPE, IGEOM) 276 : CALL LICHT(IVITC, MPVITC , TYPE, IGEOM) 276 : CALL LICHT(IGRVC, MPGRV , TYPE, IGEOM) 276 : CALL LICHT(IPC , MPPC , TYPE, IGEOM) 276 : CALL LICHT(IGRPC, MPGRP , TYPE, IGEOM) 276 : CALL LICHT(IYC , MPYC , TYPE, IGEOM) 276 : CALL LICHT(IGRYC, MPGRY , TYPE, IGEOM) 276 : CALL LICHT(IGAMC, MPGAMC , TYPE, IGEOM) 276 : CALL LICHT(INORM, MPNORM , TYPE, IGEOM) 277 : C 278 : C**** Les MPOVALs 'Prediction' 279 : C 280 : IF(LOGTEM)THEN 281 : SEGINI, MPROP = MPROC 282 : SEGINI, MPPP = MPPC 283 : SEGINI, MPVITP = MPVITC 284 : SEGINI, MPYP = MPYC 285 : ELSE 286 : MPROP = MPROC 287 : MPPP = MPPC 288 : MPVITP = MPVITC 289 : MPYP = MPYC 290 : ENDIF 291 : C 292 : C**** Les Limiteurs 293 : C 293 : CALL LICHT(IALROC, MELALR , TYPE, IGEOM) 293 : CALL LICHT(IALVC, MELALV , TYPE, IGEOM) 293 : CALL LICHT(IALPC, MELALP , TYPE, IGEOM) 293 : CALL LICHT(IALYC, MELALY , TYPE, IGEOM) 294 : C 295 : C 296 : C**** Les MPOVAL sont déjà activés i.e.: 297 : C 298 : C SEGACT MPROC 299 : C SEGACT MPGRR 300 : C SEGACT MPIALR 301 : C SEGACT MPVITC 302 : C SEGACT MPGRV 303 : C SEGACT MPIALV 304 : C SEGACT MPPC 305 : C SEGACT MPGRP 306 : C SEGACT MPIALP 307 : C SEGACT MPYC 308 : C SEGACT MPGRY 309 : C SEGACT MPIALY 310 : C SEGACT MPGAMC 311 : C SEGACT MPNORM 312 : C 313 : C**** Le MELEME FACEL 314 : C 315 : IPT1 = IFACEL 316 : IPT2 = IFACE 317 : SEGACT IPT1 318 : SEGACT IPT2 319 : NFAC = IPT1.NUM(/2) 320 : C 321 : C**** Creation de MCHAMLs contenant les etats gauche et droite, 322 : C 323 : C i.e.: 324 : C 325 : C vitesse + cosinus directors du repere local 326 : C densité 327 : C pression 328 : C gamma 329 : C 330 : C**** Cosinus directors du repere local et vitesse 331 : C 332 : C Les cosinus directeurs 333 : C 334 : N1 = 2 335 : N3 = 6 336 : L1 = 28 337 : SEGINI MCHEL1 338 : IVITF = MCHEL1 339 : MCHEL1.TITCHE = 'U ' 340 : MCHEL1.IMACHE(1) = IFACE 341 : MCHEL1.IMACHE(2) = IFACEL 342 : MCHEL1.CONCHE(1) = '(n,t,v)in(x,y,z)' 343 : MCHEL1.CONCHE(2) = ' U in (n,t,v) ' 344 : C 345 : C**** Valeurs des cosinus definies par respect au repair global, i.e. 346 : C 347 : MCHEL1.INFCHE(1,1) = 2 348 : MCHEL1.INFCHE(1,3) = NIFOUR 349 : MCHEL1.INFCHE(1,4) = 0 350 : MCHEL1.INFCHE(1,5) = 0 351 : MCHEL1.INFCHE(1,6) = 0 352 : MCHEL1.IFOCHE = IFOUR 353 : C 354 : C**** Valeurs de vitesse definies par respect au repair local, i.e. 355 : C 356 : MCHEL1.INFCHE(2,1) = 1 357 : MCHEL1.INFCHE(2,3) = NIFOUR 358 : MCHEL1.INFCHE(2,4) = 0 359 : MCHEL1.INFCHE(2,5) = 0 360 : MCHEL1.INFCHE(2,6) = 0 361 : C 362 : C**** Le cosinus directeurs 363 : C 364 : N1PTEL = 1 365 : N1EL = NFAC 366 : N2PTEL = 0 367 : N2EL = 0 368 : C 369 : C**** MCHAML a N2 composantes: 370 : C 371 : C cosinus directeurs du repere local (n,t1) 372 : C 373 : C IDIM = 3 -> 9 composantes 374 : C 375 : N2 = 9 376 : SEGINI MCHAM1 377 : MCHEL1.ICHAML(1) = MCHAM1 378 : MCHAM1.NOMCHE(1) = 'NX ' 379 : MCHAM1.NOMCHE(2) = 'NY ' 380 : MCHAM1.NOMCHE(3) = 'NZ ' 381 : MCHAM1.NOMCHE(4) = 'TX ' 382 : MCHAM1.NOMCHE(5) = 'TY ' 383 : MCHAM1.NOMCHE(6) = 'TZ ' 384 : MCHAM1.NOMCHE(7) = 'VX ' 385 : MCHAM1.NOMCHE(8) = 'VY ' 386 : MCHAM1.NOMCHE(9) = 'VZ ' 387 : MCHAM1.TYPCHE(1) = 'REAL*8 ' 388 : MCHAM1.TYPCHE(2) = 'REAL*8 ' 389 : MCHAM1.TYPCHE(3) = 'REAL*8 ' 390 : MCHAM1.TYPCHE(4) = 'REAL*8 ' 391 : MCHAM1.TYPCHE(5) = 'REAL*8 ' 392 : MCHAM1.TYPCHE(6) = 'REAL*8 ' 393 : MCHAM1.TYPCHE(7) = 'REAL*8 ' 394 : MCHAM1.TYPCHE(8) = 'REAL*8 ' 395 : MCHAM1.TYPCHE(9) = 'REAL*8 ' 396 : SEGINI MELVNX 397 : SEGINI MELVNY 398 : SEGINI MELVNZ 399 : SEGINI MELT1X 400 : SEGINI MELT1Y 401 : SEGINI MELT1Z 402 : SEGINI MELT2X 403 : SEGINI MELT2Y 404 : SEGINI MELT2Z 405 : MCHAM1.IELVAL(1) = MELVNX 406 : MCHAM1.IELVAL(2) = MELVNY 407 : MCHAM1.IELVAL(3) = MELVNZ 408 : MCHAM1.IELVAL(4) = MELT1X 409 : MCHAM1.IELVAL(5) = MELT1Y 410 : MCHAM1.IELVAL(6) = MELT1Z 411 : MCHAM1.IELVAL(7) = MELT2X 412 : MCHAM1.IELVAL(8) = MELT2Y 413 : MCHAM1.IELVAL(9) = MELT2Z 414 : SEGDES MCHAM1 415 : C 416 : C**** Vitesse 417 : C 418 : N1EL = NFAC 419 : N1PTEL = 3 420 : N2EL = 0 421 : N2PTEL = 0 422 : C 423 : C**** MCHAML a N2 composantes: 424 : C 425 : C IDIM = 3 -> 3 composantes 426 : C 427 : N2 = 3 428 : SEGINI MCHAM1 429 : MCHEL1.ICHAML(2) = MCHAM1 430 : SEGDES MCHEL1 431 : MCHAM1.NOMCHE(1) = 'UN ' 432 : MCHAM1.NOMCHE(2) = 'UT ' 433 : MCHAM1.NOMCHE(3) = 'UV ' 434 : MCHAM1.TYPCHE(1) = 'REAL*8 ' 435 : MCHAM1.TYPCHE(2) = 'REAL*8 ' 436 : MCHAM1.TYPCHE(3) = 'REAL*8 ' 437 : SEGINI MELVUN 438 : SEGINI MELVUT 439 : SEGINI MELVUV 440 : MCHAM1.IELVAL(1) = MELVUN 441 : MCHAM1.IELVAL(2) = MELVUT 442 : MCHAM1.IELVAL(3) = MELVUV 443 : SEGDES MCHAM1 444 : C 445 : C**** Densite 446 : C 447 : N1 = 1 448 : N3 = 6 449 : L1 = 15 450 : SEGINI MCHEL2 451 : IROF = MCHEL2 452 : MCHEL2.IMACHE(1) = IFACEL 453 : MCHEL2.TITCHE = 'RO ' 454 : MCHEL2.CONCHE(1) = ' ' 455 : C 456 : C**** Valeurs independente du repére, i.e. 457 : C 458 : MCHEL2.INFCHE(1,1) = 0 459 : MCHEL2.INFCHE(1,3) = NIFOUR 460 : MCHEL2.INFCHE(1,4) = 0 461 : MCHEL2.INFCHE(1,5) = 0 462 : MCHEL2.INFCHE(1,6) = 0 463 : MCHEL2.IFOCHE = IFOUR 464 : N2 = 1 465 : SEGINI MCHAM1 466 : MCHEL2.ICHAML(1) = MCHAM1 467 : SEGDES MCHEL2 468 : MCHAM1.NOMCHE(1) = 'SCAL ' 469 : MCHAM1.TYPCHE(1) = 'REAL*8 ' 470 : SEGINI MELRO 471 : MCHAM1.IELVAL(1) = MELRO 472 : SEGDES MCHAM1 473 : C 474 : C**** Pression 475 : C 476 : MCHEL1 = IROF 477 : SEGINI, MCHEL2 = MCHEL1 478 : IPF = MCHEL2 479 : MCHEL2.TITCHE = 'P ' 480 : C 481 : C**** MCHAM1 = MCHAML de la densite 482 : C 483 : SEGINI, MCHAM2 = MCHAM1 484 : MCHEL2.ICHAML(1) = MCHAM2 485 : SEGDES MCHEL2 486 : SEGINI MELP 487 : MCHAM2.IELVAL(1) = MELP 488 : SEGDES MCHAM2 489 : C 490 : C**** Gamma 491 : C 492 : MCHEL1 = IROF 493 : SEGINI, MCHEL2 = MCHEL1 494 : IGAMF = MCHEL2 495 : MCHEL2.TITCHE = 'GAMMA ' 496 : C 497 : C**** MCHAM1 = MCHAML de la densite 498 : C 499 : SEGINI, MCHAM2 = MCHAM1 500 : MCHEL2.ICHAML(1) = MCHAM2 501 : SEGDES MCHEL2 502 : SEGINI MELGAM 503 : MCHAM2.IELVAL(1) = MELGAM 504 : SEGDES MCHAM2 505 : C 506 : C**** Le CHAMELEM des fractions massiques 507 : C 508 : NESP = MPYC.VPOCHA(/2) 509 : SEGINI FRAMAS 510 : MCHEL1 = IROF 511 : SEGINI, MCHEL2 = MCHEL1 512 : IYF = MCHEL2 513 : MCHEL2.TITCHE = 'Y ' 514 : N2 = NESP 515 : SEGINI MCHAMY 516 : MCHEL2.ICHAML(1) = MCHAMY 517 : SEGDES MCHEL2 518 : N1EL = NFAC 519 : N1PTEL = 3 520 : N2EL = 0 521 : N2PTEL = 0 522 : DO I1 = 1, NESP 523 : SEGINI MELVA1 524 : MCHAMY.IELVAL(I1) = MELVA1 525 : CARCEL = MLMOT1.MOTS(I1) 526 : TYPE = ' ' 527 : TYPE(1:4) = CARCEL(1:4) 528 : MCHAMY.NOMCHE(I1) = TYPE 529 : MCHAMY.TYPCHE(I1) = 'REAL*8 ' 530 : ENDDO 531 : C 532 : C 533 : C*********************************************************************** 534 : C********* PREDICTION ************************************************** 535 : C*********************************************************************** 536 : C 537 : C**** Prediction avec gradients limités 538 : C 539 : C 540 : IF(LOGTEM)THEN 541 : C 542 : IPT3 = ICEN 543 : SEGACT IPT3 544 : NCEN = IPT3.NUM(/2) 545 : DO NLCE = 1, NCEN 546 : ROG = MPROP.VPOCHA(NLCE,1) 547 : UXG = MPVITP.VPOCHA(NLCE,1) 548 : UYG = MPVITP.VPOCHA(NLCE,2) 549 : UZG = MPVITP.VPOCHA(NLCE,3) 550 : PG = MPPP.VPOCHA(NLCE,1) 551 : DROX = MPGRR.VPOCHA(NLCE,1)*MELALR.VPOCHA(NLCE,1) 552 : DROY = MPGRR.VPOCHA(NLCE,2)*MELALR.VPOCHA(NLCE,1) 553 : DROZ = MPGRR.VPOCHA(NLCE,3)*MELALR.VPOCHA(NLCE,1) 554 : DUXX = MPGRV.VPOCHA(NLCE,1)*MELALV.VPOCHA(NLCE,1) 555 : DUXY = MPGRV.VPOCHA(NLCE,2)*MELALV.VPOCHA(NLCE,1) 556 : DUXZ = MPGRV.VPOCHA(NLCE,3)*MELALV.VPOCHA(NLCE,1) 557 : DUYX = MPGRV.VPOCHA(NLCE,4)*MELALV.VPOCHA(NLCE,2) 558 : DUYY = MPGRV.VPOCHA(NLCE,5)*MELALV.VPOCHA(NLCE,2) 559 : DUYZ = MPGRV.VPOCHA(NLCE,6)*MELALV.VPOCHA(NLCE,2) 560 : DUZX = MPGRV.VPOCHA(NLCE,7)*MELALV.VPOCHA(NLCE,3) 561 : DUZY = MPGRV.VPOCHA(NLCE,8)*MELALV.VPOCHA(NLCE,3) 562 : DUZZ = MPGRV.VPOCHA(NLCE,9)*MELALV.VPOCHA(NLCE,3) 563 : DPX = MPGRP.VPOCHA(NLCE,1)*MELALP.VPOCHA(NLCE,1) 564 : DPY = MPGRP.VPOCHA(NLCE,2)*MELALP.VPOCHA(NLCE,1) 565 : DPZ = MPGRP.VPOCHA(NLCE,3)*MELALP.VPOCHA(NLCE,1) 566 : GAMG = MPGAMC.VPOCHA(NLCE,1) 567 : DRO = UXG * DROX + ROG * ( DUXX + DUYY + DUZZ) 568 : & + UYG * DROY + UZG * DROZ 569 : DUX = UXG * DUXX + DPX / ROG + UYG * DUXY 570 : & + UZG * DUXZ 571 : DUY = UXG * DUYX + UYG * DUYY + DPY / ROG 572 : & + UZG * DUYZ 573 : DUZ = UXG * DUZX + UYG * DUZY + UZG * DUZZ 574 : & + DPZ / ROG 575 : DP = GAMG * PG * (DUXX + DUYY + DUZZ) 576 : & + UXG * DPX + UYG * DPY + UZG * DPZ 577 : C 578 : MPROP.VPOCHA(NLCE,1) = ROG - DELTAT * DRO 579 : MPVITP.VPOCHA(NLCE,1) = UXG - DELTAT * DUX 580 : MPVITP.VPOCHA(NLCE,2) = UYG - DELTAT * DUY 581 : MPVITP.VPOCHA(NLCE,3) = UZG - DELTAT * DUZ 582 : MPPP.VPOCHA(NLCE,1) = PG - DELTAT * DP 583 : DO I1 = 1, NESP 584 : INDCEL = IDIM * (I1-1) + 1 585 : ALPHA = MELALY.VPOCHA(NLCE,I1) 586 : DYMAS = UXG * MPGRY.VPOCHA(NLCE,INDCEL) * ALPHA + 587 : & UYG * MPGRY.VPOCHA(NLCE,INDCEL+1) * ALPHA + 588 : & UZG * MPGRY.VPOCHA(NLCE,INDCEL+2) * ALPHA 589 : MPYP.VPOCHA(NLCE,I1) = MPYC.VPOCHA(NLCE,I1) - 590 : & DELTAT * DYMAS 591 : ENDDO 592 : ENDDO 593 : C 594 : ENDIF 595 : C 596 : C 597 : C*********************************************************************** 598 : C********* CORRECTION ************************************************** 599 : C*********************************************************************** 600 : C 601 : C**** Boucle sur le faces 602 : C 603 : IDIMP1 = IDIM + 1 604 : DO NLCF = 1, NFAC 605 : C 606 : C******* NLCF = numero local du centre de face 607 : C NGCF = numero global du centre de face 608 : C NGCEG = numero global du centre ELT "gauche" 609 : C NLCEG = numero local du centre ELT "gauche" 610 : C NGCED = numero global du centre ELT "droite" 611 : C NLCED = numero local du centre ELT "droite" 612 : C 613 : NGCEG = IPT1.NUM(1,NLCF) 614 : NGCF = IPT1.NUM(2,NLCF) 615 : NGCED = IPT1.NUM(3,NLCF) 616 : NLCEG = MLENT1.LECT(NGCEG) 617 : NLCED = MLENT1.LECT(NGCED) 618 : C 619 : C******* TEST: IPT2.NUM(1,NLCF) = IPT1.NUM(2,NLCF) 620 : C 621 : NGCF1 = IPT2.NUM(1,NLCF) 622 : IF( NGCF1 .NE. NGCF) THEN 623 : LOGAN = .TRUE. 624 : MESERR(1:40) = 'PRET, subroutine pre221.eso ' 625 : GOTO 9999 626 : ENDIF 627 : C 628 : C******* Cosinus directeurs des NORMALES aux faces 629 : C 630 : C On impose que les normales sont direct "Gauche" -> "Centre" 631 : C 632 : INDCEL = (NGCEG-1)*IDIMP1 633 : XG = XCOOR(INDCEL+1) 634 : YG = XCOOR(INDCEL+2) 635 : ZG = XCOOR(INDCEL+3) 636 : INDCEL = (NGCF-1)*IDIMP1 637 : XC = XCOOR(INDCEL + 1) 638 : YC = XCOOR(INDCEL + 2) 639 : ZC = XCOOR(INDCEL+3) 640 : INDCEL = (NGCED-1)*IDIMP1 641 : XD = XCOOR(INDCEL+1) 642 : YD = XCOOR(INDCEL+2) 643 : ZD = XCOOR(INDCEL+3) 644 : DXG = XC - XG 645 : DYG = YC - YG 646 : DZG = ZC - ZG 647 : DXD = XC - XD 648 : DYD = YC - YD 649 : DZD = ZC - ZD 650 : C 651 : C******* On calcule le sign du pruduit scalare 652 : C (Normales de Castem) * (vecteur "gauche" -> "centre") 653 : C 654 : CNX = MPNORM.VPOCHA(NLCF,7) 655 : CNY = MPNORM.VPOCHA(NLCF,8) 656 : CNZ = MPNORM.VPOCHA(NLCF,9) 657 : ORIENT = CNX * DXG + CNY * DYG + CNZ * DZG 658 : ORIENT = SIGN(1.0D0,ORIENT) 659 : IF(ORIENT .NE. 1.0D0)THEN 660 : LOGAN = .TRUE. 661 : MESERR(1:30)= 662 : & 'PRET , subroutine pre121.eso. ' 663 : GOTO 9999 664 : ENDIF 665 : CNX = CNX * ORIENT 666 : CNY = CNY * ORIENT 667 : CNZ = CNZ * ORIENT 668 : C 669 : C********** Cosinus directeurs de tangente 1 670 : C 671 : CTX = MPNORM.VPOCHA(NLCF,1) * ORIENT 672 : CTY = MPNORM.VPOCHA(NLCF,2) * ORIENT 673 : CTZ = MPNORM.VPOCHA(NLCF,3) * ORIENT 674 : C 675 : C********** Cosinus directeurs de tangente 2 676 : C 677 : CVX = MPNORM.VPOCHA(NLCF,4) * ORIENT 678 : CVY = MPNORM.VPOCHA(NLCF,5) * ORIENT 679 : CVZ = MPNORM.VPOCHA(NLCF,6) * ORIENT 680 : C 681 : C 682 : C******* Les autres MELVALs 683 : C 684 : C 685 : C******* N.B.: On suppose qu'on a déjà controlle RO, P > 0 686 : C GAMMA \in (1,3) 687 : C Si non il faut le faire, en utilisant LOGBOR, 688 : C LOGNEG, VALER, VAL1, VAL2 689 : C 690 : C 691 : C 692 : C******* NGCEG = NGCED -> Mur 693 : C 694 : IF( NGCEG .EQ. NGCED)THEN 695 : C 696 : C********** Sur le mur on fait de reconstruction sur l'etat gauche 697 : C 698 : C 699 : C********** Etat gauche 700 : C 701 : VALCEL = MPROP.VPOCHA(NLCEG, 1) 702 : ALCEL = MELALR.VPOCHA(NLCEG, 1) 703 : DCEL = MPGRR.VPOCHA(NLCEG, 1)*DXG + 704 : & MPGRR.VPOCHA(NLCEG, 2)*DYG + 705 : & MPGRR.VPOCHA(NLCEG, 3)*DZG 706 : 707 : ROG = VALCEL + ALCEL * DCEL 708 : C 709 : VALCEL = MPPP.VPOCHA(NLCEG, 1) 710 : ALCEL = MELALP.VPOCHA(NLCEG, 1) 711 : DCEL = MPGRP.VPOCHA(NLCEG, 1)*DXG + 712 : & MPGRP.VPOCHA(NLCEG, 2)*DYG + 713 : & MPGRP.VPOCHA(NLCEG, 3)*DZG 714 : PG = VALCEL + ALCEL * DCEL 715 : C 716 : LOGI2 = .FALSE. 717 : SUMY = 0.0D0 718 : CPCEL = 0.0D0 719 : CVCEL = 0.0D0 720 : DO I1 = 1, NESP 721 : INDCEL = IDIM * (I1-1) + 1 722 : VALCEL = MPYP.VPOCHA(NLCEG,I1) 723 : ALCEL = MELALY.VPOCHA(NLCEG, I1) 724 : DCEL = MPGRY.VPOCHA(NLCEG, INDCEL)*DXG + 725 : & MPGRY.VPOCHA(NLCEG,INDCEL + 1 )*DYG + 726 : & MPGRY.VPOCHA(NLCEG,INDCEL + 2 )*DZG 727 : ALCEL = VALCEL + ALCEL * DCEL 728 : SUMY = SUMY + ALCEL 729 : CPCEL = CPCEL + MLRECP.PROG(I1) * ALCEL 730 : CVCEL = CVCEL + MLRECV.PROG(I1) * ALCEL 731 : LOGI2 = LOGI2 .OR. (ALCEL .LT. 0.0D0) 732 : FRAMAS.FRAMG(I1) = ALCEL 733 : ENDDO 734 : LOGI2 = LOGI2 .OR. (SUMY .GT. 1.0D0) 735 : CPCEL = CPCEL + (1.0D0 - SUMY) * MLRECP.PROG(NESP+1) 736 : CVCEL = CVCEL + (1.0D0 - SUMY) * MLRECV.PROG(NESP+1) 737 : GAMG = CPCEL / CVCEL 738 : C 739 : VALCEL = MPVITP.VPOCHA(NLCEG, 1) 740 : ALCEL = MELALV.VPOCHA(NLCEG, 1) 741 : DCEL = MPGRV.VPOCHA(NLCEG, 1)*DXG + 742 : & MPGRV.VPOCHA(NLCEG, 2)*DYG + 743 : & MPGRV.VPOCHA(NLCEG, 3)*DZG 744 : UXG = VALCEL + ALCEL * DCEL 745 : C 746 : VALCEL = MPVITP.VPOCHA(NLCEG, 2) 747 : ALCEL = MELALV.VPOCHA(NLCEG, 2) 748 : DCEL = MPGRV.VPOCHA(NLCEG, 4)*DXG + 749 : & MPGRV.VPOCHA(NLCEG, 5)*DYG + 750 : & MPGRV.VPOCHA(NLCEG, 6)*DZG 751 : UYG = VALCEL + ALCEL * DCEL 752 : C 753 : VALCEL = MPVITP.VPOCHA(NLCEG, 3) 754 : ALCEL = MELALV.VPOCHA(NLCEG, 3) 755 : DCEL = MPGRV.VPOCHA(NLCEG, 7)*DXG + 756 : & MPGRV.VPOCHA(NLCEG, 8)*DYG + 757 : & MPGRV.VPOCHA(NLCEG, 9)*DZG 758 : UZG = VALCEL + ALCEL * DCEL 759 : C 760 : UNG = UXG * CNX + UYG * CNY + UZG * CNZ 761 : UTG = UXG * CTX + UYG * CTY + UZG * CTZ 762 : UVG = UXG * CVX + UYG * CVY + UZG * CVZ 763 : C 764 : C********** Si l'on fait pas de prediction, ce n'est pas necessaire de 765 : C controller la positivite' de la pression et de la densité; elle 766 : C est déjà garantie par la proprieté LED de limiteur; mais, vu 767 : C que le limiteur n'est pas calculé ici, mais dans un autre 768 : C operateur, on le fait 769 : C 770 : C AB 771 : C 2010/09/14: LOGI1 computed can destroy the symmetry! 772 : C LOGI1 = (PG .LT. 0.0D0) .OR. (ROG .LT. 0.0D0) .OR. LOGI2 773 : C 774 : IF(LOGI1)THEN 775 : C 776 : C************* Premier ordre en espace local 777 : C 778 : ROG = MPROC.VPOCHA(NLCEG,1) 779 : ROD = ROG 780 : PG = MPPC.VPOCHA(NLCEG,1) 781 : PD = PG 782 : UNG = MPVITC.VPOCHA(NLCEG,1)*CNX + 783 : & MPVITC.VPOCHA(NLCEG,2)*CNY + 784 : & MPVITC.VPOCHA(NLCEG,3)*CNZ 785 : UTG = MPVITC.VPOCHA(NLCEG,1)*CTX + 786 : & MPVITC.VPOCHA(NLCEG,2)*CTY + 787 : & MPVITC.VPOCHA(NLCEG,3)*CTZ 788 : UVG = MPVITC.VPOCHA(NLCEG,1)*CVX + 789 : & MPVITC.VPOCHA(NLCEG,2)*CVY + 790 : & MPVITC.VPOCHA(NLCEG,3)*CVZ 791 : UND = -1.0D0 * UNG 792 : UTD = UTG 793 : UVD = UVG 794 : DO I1 = 1, NESP 795 : FRAMAS.FRAMG(I1) = MPYC.VPOCHA(NLCEG,I1) 796 : FRAMAS.FRAMD(I1) = FRAMAS.FRAMG(I1) 797 : ENDDO 798 : GAMG = MPGAMC.VPOCHA(NLCEG,1) 799 : GAMD = GAMG 800 : ELSE 801 : C 802 : C********** Son etat droite 803 : C 804 : ROD = ROG 805 : PD = PG 806 : UND = -1.0D0 * UNG 807 : UTD = UTG 808 : UVD = UVG 809 : DO I1 = 1, NESP 810 : FRAMAS.FRAMD(I1) = FRAMAS.FRAMG(I1) 811 : ENDDO 812 : GAMD = GAMG 813 : ENDIF 814 : C 815 : C************* Fin cas mur 816 : C 817 : ELSE 818 : C 819 : C************* Etat gauche 820 : C 821 : VALCEL = MPROP.VPOCHA(NLCEG, 1) 822 : ALCEL = MELALR.VPOCHA(NLCEG, 1) 823 : DCEL = MPGRR.VPOCHA(NLCEG, 1)*DXG + 824 : & MPGRR.VPOCHA(NLCEG, 2)*DYG + 825 : & MPGRR.VPOCHA(NLCEG, 3)*DZG 826 : 827 : ROG = VALCEL + ALCEL * DCEL 828 : C 829 : VALCEL = MPPP.VPOCHA(NLCEG, 1) 830 : ALCEL = MELALP.VPOCHA(NLCEG, 1) 831 : DCEL = MPGRP.VPOCHA(NLCEG, 1)*DXG + 832 : & MPGRP.VPOCHA(NLCEG, 2)*DYG + 833 : & MPGRP.VPOCHA(NLCEG, 3)*DZG 834 : PG = VALCEL + ALCEL * DCEL 835 : C 836 : LOGI2 = .FALSE. 837 : SUMY = 0.0D0 838 : CPCEL = 0.0D0 839 : CVCEL = 0.0D0 840 : DO I1 = 1, NESP 841 : INDCEL = IDIM * (I1-1) + 1 842 : VALCEL = MPYP.VPOCHA(NLCEG,I1) 843 : ALCEL = MELALY.VPOCHA(NLCEG, I1) 844 : DCEL = MPGRY.VPOCHA(NLCEG, INDCEL)*DXG + 845 : & MPGRY.VPOCHA(NLCEG,INDCEL + 1 )*DYG + 846 : & MPGRY.VPOCHA(NLCEG,INDCEL + 2 )*DZG 847 : ALCEL = VALCEL + ALCEL * DCEL 848 : SUMY = SUMY + ALCEL 849 : CPCEL = CPCEL + MLRECP.PROG(I1) * ALCEL 850 : CVCEL = CVCEL + MLRECV.PROG(I1) * ALCEL 851 : LOGI2 = LOGI2 .OR. (ALCEL .LT. 0.0D0) 852 : FRAMAS.FRAMG(I1) = ALCEL 853 : ENDDO 854 : LOGI2 = LOGI2 .OR. (SUMY .GT. 1.0D0) 855 : CPCEL = CPCEL + (1.0D0 - SUMY) * MLRECP.PROG(NESP+1) 856 : CVCEL = CVCEL + (1.0D0 - SUMY) * MLRECV.PROG(NESP+1) 857 : GAMG = CPCEL / CVCEL 858 : C 859 : VALCEL = MPVITP.VPOCHA(NLCEG, 1) 860 : ALCEL = MELALV.VPOCHA(NLCEG, 1) 861 : DCEL = MPGRV.VPOCHA(NLCEG, 1)*DXG + 862 : & MPGRV.VPOCHA(NLCEG, 2)*DYG + 863 : & MPGRV.VPOCHA(NLCEG, 3)*DZG 864 : UXG = VALCEL + ALCEL * DCEL 865 : C 866 : VALCEL = MPVITP.VPOCHA(NLCEG, 2) 867 : ALCEL = MELALV.VPOCHA(NLCEG, 2) 868 : DCEL = MPGRV.VPOCHA(NLCEG, 4)*DXG + 869 : & MPGRV.VPOCHA(NLCEG, 5)*DYG + 870 : & MPGRV.VPOCHA(NLCEG, 6)*DZG 871 : UYG = VALCEL + ALCEL * DCEL 872 : C 873 : VALCEL = MPVITP.VPOCHA(NLCEG, 3) 874 : ALCEL = MELALV.VPOCHA(NLCEG, 3) 875 : DCEL = MPGRV.VPOCHA(NLCEG, 7)*DXG + 876 : & MPGRV.VPOCHA(NLCEG, 8)*DYG + 877 : & MPGRV.VPOCHA(NLCEG, 9)*DZG 878 : UZG = VALCEL + ALCEL * DCEL 879 : C 880 : UNG = UXG * CNX + UYG * CNY + UZG * CNZ 881 : UTG = UXG * CTX + UYG * CTY + UZG * CTZ 882 : UVG = UXG * CVX + UYG * CVY + UZG * CVZ 883 : C 884 : C********** Positivite 885 : C 886 : C AB 887 : C 2010/09/14: LOGI1 computed can destroy the symmetry! 888 : C LOGI1 = (PG .LT. 0.0D0) .OR. (ROG .LT. 0.0D0) .OR. LOGI2 889 : C 890 : IF(LOGI1)THEN 891 : C 892 : C************* Premier ordre en espace local 893 : C 894 : ROG = MPROC.VPOCHA(NLCEG,1) 895 : PG = MPPC.VPOCHA(NLCEG,1) 896 : UNG = MPVITC.VPOCHA(NLCEG,1)*CNX + 897 : & MPVITC.VPOCHA(NLCEG,2)*CNY + 898 : & MPVITC.VPOCHA(NLCEG,3)*CNZ 899 : UTG = MPVITC.VPOCHA(NLCEG,1)*CTX + 900 : & MPVITC.VPOCHA(NLCEG,2)*CTY + 901 : & MPVITC.VPOCHA(NLCEG,3)*CTZ 902 : UVG = MPVITC.VPOCHA(NLCEG,1)*CVX + 903 : & MPVITC.VPOCHA(NLCEG,2)*CVY + 904 : & MPVITC.VPOCHA(NLCEG,3)*CVZ 905 : DO I1 = 1, NESP 906 : FRAMAS.FRAMG(I1) = MPYC.VPOCHA(NLCEG,I1) 907 : ENDDO 908 : GAMG = MPGAMC.VPOCHA(NLCEG,1) 909 : ENDIF 910 : C 911 : C********** Etat droite 912 : C 913 : VALCEL = MPROP.VPOCHA(NLCED, 1) 914 : ALCEL = MELALR.VPOCHA(NLCED, 1) 915 : DCEL = MPGRR.VPOCHA(NLCED, 1)*DXD + 916 : & MPGRR.VPOCHA(NLCED, 2)*DYD + 917 : & MPGRR.VPOCHA(NLCED, 3)*DZD 918 : ROD = VALCEL + ALCEL * DCEL 919 : C 920 : VALCEL = MPPP.VPOCHA(NLCED, 1) 921 : ALCEL = MELALP.VPOCHA(NLCED, 1) 922 : DCEL = MPGRP.VPOCHA(NLCED, 1)*DXD + 923 : & MPGRP.VPOCHA(NLCED, 2)*DYD + 924 : & MPGRP.VPOCHA(NLCED, 3)*DZD 925 : PD = VALCEL + ALCEL * DCEL 926 : C 927 : LOGI2 = .FALSE. 928 : SUMY = 0.0D0 929 : CPCEL = 0.0D0 930 : CVCEL = 0.0D0 931 : DO I1 = 1, NESP 932 : INDCEL = IDIM * (I1-1) + 1 933 : VALCEL = MPYP.VPOCHA(NLCED,I1) 934 : ALCEL = MELALY.VPOCHA(NLCED, I1) 935 : DCEL = MPGRY.VPOCHA(NLCED, INDCEL)*DXD + 936 : & MPGRY.VPOCHA(NLCED,INDCEL + 1 )*DYD + 937 : & MPGRY.VPOCHA(NLCED,INDCEL + 2 )*DZD 938 : ALCEL = VALCEL + ALCEL * DCEL 939 : SUMY = SUMY + ALCEL 940 : CPCEL = CPCEL + MLRECP.PROG(I1) * ALCEL 941 : CVCEL = CVCEL + MLRECV.PROG(I1) * ALCEL 942 : LOGI2 = LOGI2 .OR. (ALCEL .LT. 0.0D0) 943 : FRAMAS.FRAMD(I1) = ALCEL 944 : ENDDO 945 : LOGI2 = LOGI2 .OR. (SUMY .GT. 1.0D0) 946 : CPCEL = CPCEL + (1.0D0 - SUMY) * MLRECP.PROG(NESP+1) 947 : CVCEL = CVCEL + (1.0D0 - SUMY) * MLRECV.PROG(NESP+1) 948 : GAMD = CPCEL / CVCEL 949 : C 950 : VALCEL = MPVITP.VPOCHA(NLCED, 1) 951 : ALCEL = MELALV.VPOCHA(NLCED, 1) 952 : DCEL = MPGRV.VPOCHA(NLCED, 1)*DXD + 953 : & MPGRV.VPOCHA(NLCED, 2)*DYD + 954 : & MPGRV.VPOCHA(NLCED, 3)*DZD 955 : UXD = VALCEL + ALCEL * DCEL 956 : C 957 : VALCEL = MPVITP.VPOCHA(NLCED, 2) 958 : ALCEL = MELALV.VPOCHA(NLCED, 2) 959 : DCEL = MPGRV.VPOCHA(NLCED, 4)*DXD + 960 : & MPGRV.VPOCHA(NLCED, 5)*DYD + 961 : & MPGRV.VPOCHA(NLCED, 6)*DZD 962 : UYD = VALCEL + ALCEL * DCEL 963 : C 964 : VALCEL = MPVITP.VPOCHA(NLCED, 3) 965 : ALCEL = MELALV.VPOCHA(NLCED, 3) 966 : DCEL = MPGRV.VPOCHA(NLCED, 7)*DXD + 967 : & MPGRV.VPOCHA(NLCED, 8)*DYD + 968 : & MPGRV.VPOCHA(NLCED, 9)*DZD 969 : UZD = VALCEL + ALCEL * DCEL 970 : C 971 : UND = UXD * CNX + UYD * CNY + UZD * CNZ 972 : UTD = UXD * CTX + UYD * CTY + UZD * CTZ 973 : UVD = UXD * CVX + UYD * CVY + UZD * CVZ 974 : C 975 : C********** Positivite 976 : C 977 : C AB 978 : C 2010/09/14: LOGI1 computed can destroy the symmetry! 979 : C LOGI1 = (PD .LT. 0.0D0) .OR. (ROD .LT. 0.0D0) .OR. LOGI2 980 : C 981 : IF(LOGI1)THEN 982 : C 983 : C************* Premier ordre en espace local 984 : C 985 : ROD = MPROC.VPOCHA(NLCED,1) 986 : PD = MPPC.VPOCHA(NLCED,1) 987 : UND = MPVITC.VPOCHA(NLCED,1)*CNX + 988 : & MPVITC.VPOCHA(NLCED,2)*CNY + 989 : & MPVITC.VPOCHA(NLCED,3)*CNZ 990 : UTD = MPVITC.VPOCHA(NLCED,1)*CTX + 991 : & MPVITC.VPOCHA(NLCED,2)*CTY + 992 : & MPVITC.VPOCHA(NLCED,3)*CTZ 993 : UVD = MPVITC.VPOCHA(NLCED,1)*CVX + 994 : & MPVITC.VPOCHA(NLCED,2)*CVY + 995 : & MPVITC.VPOCHA(NLCED,3)*CVZ 996 : DO I1 = 1, NESP 997 : FRAMAS.FRAMD(I1) = MPYC.VPOCHA(NLCED,I1) 998 : ENDDO 999 : GAMD = MPGAMC.VPOCHA(NLCED,1) 1000 : ENDIF 1001 : ENDIF 1002 : C 1003 : C******** Les MELVALs 1004 : C 1005 : MELRO.VELCHE(1,NLCF) = ROG 1006 : MELRO.VELCHE(3,NLCF) = ROD 1007 : MELP.VELCHE(1,NLCF) = PG 1008 : MELP.VELCHE(3,NLCF) = PD 1009 : MELGAM.VELCHE(1,NLCF) = GAMG 1010 : MELGAM.VELCHE(3,NLCF) = GAMD 1011 : MELVUN.VELCHE(1,NLCF) = UNG 1012 : MELVUN.VELCHE(3,NLCF) = UND 1013 : MELVUT.VELCHE(1,NLCF) = UTG 1014 : MELVUT.VELCHE(3,NLCF) = UTD 1015 : MELVUV.VELCHE(1,NLCF) = UVG 1016 : MELVUV.VELCHE(3,NLCF) = UVD 1017 : MELVNX.VELCHE(1,NLCF) = CNX 1018 : MELVNY.VELCHE(1,NLCF) = CNY 1019 : MELVNZ.VELCHE(1,NLCF) = CNZ 1020 : MELT1X.VELCHE(1,NLCF) = CTX 1021 : MELT1Y.VELCHE(1,NLCF) = CTY 1022 : MELT1Z.VELCHE(1,NLCF) = CTZ 1023 : MELT2X.VELCHE(1,NLCF) = CVX 1024 : MELT2Y.VELCHE(1,NLCF) = CVY 1025 : MELT2Z.VELCHE(1,NLCF) = CVZ 1026 : DO I1 = 1, NESP 1027 : MELVA1 = MCHAMY.IELVAL(I1) 1028 : MELVA1.VELCHE(1,NLCF) = FRAMAS.FRAMG(I1) 1029 : MELVA1.VELCHE(3,NLCF) = FRAMAS.FRAMD(I1) 1030 : ENDDO 1031 : ENDDO 1032 : C 1033 : C**** Desactivation des SEGMENTs 1034 : C 1035 : SEGDES IPT1 1036 : SEGDES IPT2 1037 : C 1038 : C**** Le MPOVALs 'Prediction' sont detruits (si existentes) 1039 : C 1040 : IF(LOGTEM)THEN 1041 : SEGSUP MPROP 1042 : SEGSUP MPVITP 1043 : SEGSUP MPPP 1044 : SEGSUP MPYP 1045 : ENDIF 1046 : C 1047 : SEGDES MPROC 1048 : SEGDES MPGRR 1049 : SEGDES MELALR 1050 : SEGDES MPVITC 1051 : SEGDES MPGRV 1052 : SEGDES MELALV 1053 : SEGDES MPPC 1054 : SEGDES MPGRP 1055 : SEGDES MELALP 1056 : SEGDES MPYC 1057 : SEGDES MPGRY 1058 : SEGDES MELALY 1059 : SEGDES MPGAMC 1060 : SEGDES MPNORM 1061 : C 1062 : SEGDES MELRO 1063 : SEGDES MELP 1064 : SEGDES MELGAM 1065 : SEGDES MELVUN 1066 : SEGDES MELVUT 1067 : SEGDES MELVUV 1068 : SEGDES MELVNX 1069 : SEGDES MELVNY 1070 : SEGDES MELVNZ 1071 : SEGDES MELT1X 1072 : SEGDES MELT1Y 1073 : SEGDES MELT1Z 1074 : SEGDES MELT2X 1075 : SEGDES MELT2Y 1076 : SEGDES MELT2Z 1077 : C 1078 : SEGDES MPYC 1079 : DO I1 = 1, NESP 1080 : MELVA1 = MCHAMY.IELVAL(I1) 1081 : SEGDES MELVA1 1082 : ENDDO 1083 : SEGDES MCHAMY 1084 : SEGSUP FRAMAS 1085 : C 1086 : SEGDES MLMOT1 1087 : CC 1088 : C**** Destruction du MELNTI correspondance local/global 1089 : C 1090 : SEGSUP MLENT1 1091 : C 1092 : 9999 CONTINUE 1093 : C 1094 : RETURN 1095 : END 1096 : 1097 : 1098 : 1099 : 1100 : 1101 : 1102 : 1103 : 1104 : 1105 :
© Cast3M 2003 - All rights reserved.
Disclaimer