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