1 : C PRE121 SOURCE PV 09/03/12 21:30:35 6325 2 : SUBROUTINE PRE121(LOGTEM, 3 : & ICEN,IFACE,IFACEL,INORM, 4 : & IROC, IGRROC, IALROC, 5 : & IVITC, IGRVC, IALVC, 6 : & IPC ,IGRPC, IALPC, 7 : & IGAMC, 8 : & DELTAT, 9 : & IROF,IVITF,IPF,IGAMF, 10 : & LOGAN,LOGNEG,LOGBOR,MESERR,VALER,VAL1,VAL2) 11 : C************************************************************************ 12 : C 13 : C PROJET : CASTEM 2000 14 : C 15 : C NOM : PRE121 16 : C 17 : C DESCRIPTION : Voir PRE12 18 : C 19 : C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI) 20 : C 21 : C AUTEUR : A. BECCANTINI, DRN/DMT/SEMT/TTMF 22 : C 23 : C************************************************************************ 24 : C 25 : C 26 : C APPELES (Outils) : KRIPAD, LICHT 27 : C 28 : C APPELES (Calcul) : AUCUN 29 : C 30 : C 31 : C************************************************************************ 32 : C 33 : C ENTREES 34 : C 35 : C LOGTEM : LOGICAL; si .TRUE. 2em ordre en temps 36 : C sinon 1er ordre en temps 37 : C 38 : C 1) Pointeurs de MELEMEs et de CHPOINTs de la table DOMAINE 39 : C 40 : C ICEN : MELEME de 'POI1' SPG des CENTRES 41 : C 42 : C IFACE : MELEME de 'POI1' SPG des FACES 43 : C 44 : C IFACEL : MELEME de 'SEG3' avec 45 : C CENTRE d'Elt "gauche" 46 : C CENTRE de Face 47 : C CENTRE d'Elt "droite" 48 : C 49 : C N.B. = IFACE.NUM(i,1) = IFACEL.NUM(i,2) 50 : C 51 : C INORM : CHPOINT des cosinus directeurs de normales aux faces 52 : C 53 : C 2) Pointeurs des CHPOINTs 54 : C 55 : C IROC : CHPOINT "CENTRE" contenant la masse volumique RHO 56 : C 57 : C IGRROC : CHPOINT "CENTRE" contenant le gradient de la 58 : C masse volumique RHO (2 composantes) 59 : C 60 : C IALROC : CHPOINT "CENTRE" contenant le limiteur du gradient 61 : C de la masse volumique 62 : C 63 : C IVITC : CHPOINT "CENTRE" contenant la vitesse UX, UY ; 64 : C 65 : C IGRVC : CHPOINT "CENTRE" contenant le gradient de la 66 : C vitesse (4 composantes) 67 : C 68 : C IALVC : CHPOINT "CENTRE" contenant le limiteur du gradient 69 : C de la vitesse (2 composantes) 70 : C 71 : C IPC : CHPOINT "CENTRE" contenat la pression P; 72 : C 73 : C IGRPC : CHPOINT "CENTRE" contenant le gradient de la 74 : C pression (2 composantes) 75 : C 76 : C IALPC : CHPOINT "CENTRE" contenant le limiteur du gradient 77 : C de la pression 78 : C 79 : C IGAMC : CHPOINT "CENTRE" contenat le "Gamma" du gaz 80 : C 81 : C 3) 82 : C 83 : C DELTAT : REAL*8, encrement en temps pour calculer la prediction 84 : C 85 : C 86 : C SORTIES 87 : C 88 : C 89 : C IROF : MCHAML defini sur le MELEME de pointeur IFACEL, 90 : C contenant la masse volumique RHO 91 : C 92 : C IVITF : MCHAML defini sur le MELEME de pointeur IFACEL, 93 : C contenant la vitesse UN, UT dans le repaire local 94 : C (n,t) et defini sur le MELEME de pointeur IFACE, 95 : C contenant les cosinus directeurs du repere local 96 : C 97 : C IPF : MCHAML defini sur le MELEME de pointeur IFACEL, 98 : C contenant la pression P 99 : C 100 : C IGAMF : MCHAML defini sur le MELEME de pointeur IFACEL, 101 : C contenant le "gamma" du gaz 102 : C 103 : C LOGAN : anomalie detectee 104 : C 105 : C LOGNEG : (LOGICAL): si .TRUE. une pression ou une densité 106 : C negative a été detectée -> en interactif le 107 : C programme s'arrete en GIBIANE 108 : C (erreur stocké en MESERR et VALER) 109 : C 110 : C LOGBOR : (LOGICAL): si .TRUE. un gamma a ete detecte 111 : C dehor 1 et 3 (sa valeur stockée en MESERR et VALER; 112 : C en VAL1 et en VAL2 on stocke 1.0 et 3.0) 113 : C 114 : C MESERR 115 : C VALER 116 : C VAL1, 117 : C VAL2 : pour les messages d'erreur 118 : C 119 : C************************************************************************ 120 : C 121 : C HISTORIQUE (Anomalies et modifications éventuelles) 122 : C 123 : C HISTORIQUE : Créée le 11.6.98. 124 : C 125 : C************************************************************************ 126 : C 127 : C 128 : C ATTENTION: Cet programme marche si le MAILLAGE est convex; 129 : C si non il faut changer l'argoritme de calcul de 130 : C l'orientation des normales aux faces. 131 : C 132 : C La positivité n'est pas controlle parce que c'est déjà fait 133 : C dans l'operateur PRIM 134 : C 135 : C 136 : C************************************************************************ 137 : C 138 : C**** Variables de COOPTIO 139 : C 140 : C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR 141 : C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ 142 : C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES 143 : C & ,IECHO, IIMPI, IOSPI 144 : C & ,IDIM 145 : CC & ,MCOORD 146 : C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE 147 : C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU 148 : C & ,NORINC,NORVAL,NORIND,NORVAD 149 : C & ,NUCROU, IPSAUV 150 : C 151 : C**** Les variables 152 : C 153 : IMPLICIT INTEGER(I-N) 154 : INTEGER ICEN, IFACE, IFACEL, INORM,IROC, IGRROC, IALROC 155 : & , IVITC, IGRVC, IALVC 156 : & , IPC ,IGRPC, IALPC 157 : & , IGAMC 158 : & , IROF, IVITF, IPF, IGAMF 159 : & , IGEOM, NFAC, NCEN 160 : & , N1PTEL, N1EL, N2PTEL, N2EL, N2, N1, N3, L1, NLCE 161 : & , NLCF, NGCF, NGCEG, NLCEG, NGCED, NLCED, NGCF1 162 : & , IDIMP1, INDCEL 163 : REAL*8 VALER, VAL1, VAL2, XG, YG, XC, YC, XD, YD, DELTAT 164 : & ,DXG, DYG, DXD, DYD 165 : & , CNX, CNY, CTX, CTY, ORIENT 166 : & , ROG, PG, GAMG, UXG, UYG, UNG, UTG 167 : & , ROD, PD, GAMD, UXD, UYD, UND, UTD 168 : & , VALCEL, DCEL, ALCEL 169 : & , DROX, DROY, DUXX, DUXY, DUYX, DUYY, DPX, DPY 170 : & , DRO, DUX, DUY, DP, ALPHA(4) 171 : CHARACTER*(40) MESERR 172 : CHARACTER*(8) TYPE 173 : LOGICAL LOGAN,LOGNEG, LOGBOR, LOGTEM, LOGI1, LOGALP 174 : C 175 : C**** LOGALP = .TRUE. -> Prediction avec limiteur 176 : C 177 : PARAMETER(LOGALP = .TRUE.) 178 : C 179 : C**** Les Includes 180 : C 181 : -INC SMCOORD 182 : -INC CCOPTIO 183 : -INC SMCHPOI 184 : POINTEUR MPROC.MPOVAL, MPGRR.MPOVAL, 185 : & MPVITC.MPOVAL, MPGRV.MPOVAL, 186 : & MPPC.MPOVAL, MPGRP.MPOVAL, 187 : & MPGAMC.MPOVAL, MPNORM.MPOVAL, 188 : & MPROP.MPOVAL, MPPP.MPOVAL, MPVITP.MPOVAL 189 : -INC SMCHAML 190 : POINTEUR MELVNX.MELVAL, MELVNY.MELVAL, 191 : & MELT1X.MELVAL, MELT1Y.MELVAL 192 : POINTEUR MELVUN.MELVAL, MELVUT.MELVAL 193 : POINTEUR MELRO.MELVAL, MELP.MELVAL, 194 : & MELGAM.MELVAL 195 : POINTEUR MELALR.MPOVAL, 196 : & MELALV.MPOVAL, 197 : & MELALP.MPOVAL 198 : -INC SMLENTI 199 : -INC SMELEME 200 : C 201 : C 202 : C**** Initialisation des parametres d'erreur déjà faite, i.e. 203 : C 204 : C LOGNEG = .FALSE. 205 : C LOGBOR = .FALSE. 206 : C MESERR = ' ' 207 : C MOTERR(1:40) = MESERR(1:40) 208 : C VALER = 0.0D0 209 : C VAL1 = 0.0D0 210 : C VAL2 = 0.0D0 211 : C 212 : C 213 : C**** KRIPAD pour la correspondance global/local de centre 214 : C 214 : CALL KRIPAD(ICEN,MLENT1) 215 : C 216 : C**** MLENTI1 a MCORD.XCOORD(/1)/(IDIM+1) elements 217 : C 218 : C Si i est le numero global d'un noeud de ICEN, 219 : C MLENT1.LECT(i) contient sa position, i.e. 220 : C 221 : C I = numero global du noeud centre 222 : C MLENT1.LECT(i) = numero local du noeud centre 223 : C 224 : C MLENT1 déjà activé, i.e. 225 : C 226 : C SEGACT MLENT1 227 : C 228 : C**** Activation de CHPOINTs 229 : C 230 : C densité + grad + limiteur 231 : C vitesse + grad + limiteur 232 : C pression + grad + limiteur 233 : C gamma 234 : C cosinus directeurs des normales aux surface 235 : C 235 : CALL LICHT(IROC , MPROC , TYPE, IGEOM) 235 : CALL LICHT(IGRROC, MPGRR , TYPE, IGEOM) 235 : CALL LICHT(IVITC, MPVITC , TYPE, IGEOM) 235 : CALL LICHT(IGRVC, MPGRV , TYPE, IGEOM) 235 : CALL LICHT(IPC , MPPC , TYPE, IGEOM) 235 : CALL LICHT(IGRPC, MPGRP , TYPE, IGEOM) 235 : CALL LICHT(IGAMC, MPGAMC , TYPE, IGEOM) 235 : CALL LICHT(INORM, MPNORM , TYPE, IGEOM) 236 : C 237 : C**** Les MPOVALs 'Prediction' 238 : C 239 : IF(LOGTEM)THEN 240 : SEGINI, MPROP = MPROC 241 : SEGINI, MPPP = MPPC 242 : SEGINI, MPVITP = MPVITC 243 : ELSE 244 : MPROP = MPROC 245 : MPPP = MPPC 246 : MPVITP = MPVITC 247 : ENDIF 248 : C 249 : C**** Les Limiteurs 250 : C 250 : CALL LICHT(IALROC, MELALR , TYPE, IGEOM) 250 : CALL LICHT(IALVC, MELALV , TYPE, IGEOM) 250 : CALL LICHT(IALPC, MELALP , TYPE, IGEOM) 251 : C 252 : C 253 : C**** MPOVAL sont déjà activés i.e.: 254 : C 255 : C SEGACT MPROC 256 : C SEGACT MPGRR 257 : C SEGACT MPIALR 258 : C SEGACT MPVITC 259 : C SEGACT MPGRV 260 : C SEGACT MPIALV 261 : C SEGACT MPPC 262 : C SEGACT MPGRP 263 : C SEGACT MPIALP 264 : C SEGACT MPGAMC 265 : C SEGACT MPNORM 266 : C 267 : C**** Le MELEME FACEL 268 : C 269 : IPT1 = IFACEL 270 : IPT2 = IFACE 271 : SEGACT IPT1 272 : SEGACT IPT2 273 : NFAC = IPT1.NUM(/2) 274 : C 275 : C**** Creation de MCHAMLs contenant les etats gauche et droite, 276 : C 277 : C i.e.: 278 : C 279 : C vitesse + cosinus directors du repere local 280 : C densité 281 : C pression 282 : C gamma 283 : C 284 : C**** Cosinus directors du repere local et vitesse 285 : C 286 : C Les cosinus directeurs 287 : C 288 : N1 = 2 289 : N3 = 6 290 : L1 = 28 291 : SEGINI MCHEL1 292 : IVITF = MCHEL1 293 : MCHEL1.TITCHE = 'U ' 294 : MCHEL1.IMACHE(1) = IFACE 295 : MCHEL1.IMACHE(2) = IFACEL 296 : MCHEL1.CONCHE(1) = ' (n,t) in (x,y) ' 297 : MCHEL1.CONCHE(2) = ' U in (n,t) ' 298 : C 299 : C**** Valeurs des cosinus definies par respect au repair global, i.e. 300 : C 301 : MCHEL1.INFCHE(1,1) = 2 302 : MCHEL1.INFCHE(1,3) = NIFOUR 303 : MCHEL1.INFCHE(1,4) = 0 304 : MCHEL1.INFCHE(1,5) = 0 305 : MCHEL1.INFCHE(1,6) = 0 306 : MCHEL1.IFOCHE = IFOUR 307 : C 308 : C**** Valeurs de vitesse definies par respect au repair local, i.e. 309 : C 310 : MCHEL1.INFCHE(2,1) = 1 311 : MCHEL1.INFCHE(2,3) = NIFOUR 312 : MCHEL1.INFCHE(2,4) = 0 313 : MCHEL1.INFCHE(2,5) = 0 314 : MCHEL1.INFCHE(2,6) = 0 315 : C 316 : C**** Le cosinus directeurs 317 : C 318 : N1PTEL = 1 319 : N1EL = NFAC 320 : N2PTEL = 0 321 : N2EL = 0 322 : C 323 : C**** MCHAML a N2 composantes: 324 : C 325 : C cosinus directeurs du repere local (n,t1) 326 : C 327 : C IDIM = 2 -> 4 composantes 328 : C 329 : N2 = 4 330 : SEGINI MCHAM1 331 : MCHEL1.ICHAML(1) = MCHAM1 332 : MCHAM1.NOMCHE(1) = 'NX ' 333 : MCHAM1.NOMCHE(2) = 'NY ' 334 : MCHAM1.NOMCHE(3) = 'TX ' 335 : MCHAM1.NOMCHE(4) = 'TY ' 336 : MCHAM1.TYPCHE(1) = 'REAL*8 ' 337 : MCHAM1.TYPCHE(2) = 'REAL*8 ' 338 : MCHAM1.TYPCHE(3) = 'REAL*8 ' 339 : MCHAM1.TYPCHE(4) = 'REAL*8 ' 340 : SEGINI MELVNX 341 : SEGINI MELVNY 342 : SEGINI MELT1X 343 : SEGINI MELT1Y 344 : MCHAM1.IELVAL(1) = MELVNX 345 : MCHAM1.IELVAL(2) = MELVNY 346 : MCHAM1.IELVAL(3) = MELT1X 347 : MCHAM1.IELVAL(4) = MELT1Y 348 : SEGDES MCHAM1 349 : C 350 : C**** Vitesse 351 : C 352 : N1EL = NFAC 353 : N1PTEL = 3 354 : N2EL = 0 355 : N2PTEL = 0 356 : C 357 : C**** MCHAML a N2 composantes: 358 : C 359 : C IDIM = 2 -> 2 composantes 360 : C 361 : N2 = 2 362 : SEGINI MCHAM1 363 : MCHEL1.ICHAML(2) = MCHAM1 364 : SEGDES MCHEL1 365 : MCHAM1.NOMCHE(1) = 'UN ' 366 : MCHAM1.NOMCHE(2) = 'UT ' 367 : MCHAM1.TYPCHE(1) = 'REAL*8 ' 368 : MCHAM1.TYPCHE(2) = 'REAL*8 ' 369 : SEGINI MELVUN 370 : SEGINI MELVUT 371 : MCHAM1.IELVAL(1) = MELVUN 372 : MCHAM1.IELVAL(2) = MELVUT 373 : SEGDES MCHAM1 374 : C 375 : C**** Densite 376 : C 377 : N1 = 1 378 : N3 = 6 379 : L1 = 15 380 : SEGINI MCHEL2 381 : IROF = MCHEL2 382 : MCHEL2.IMACHE(1) = IFACEL 383 : MCHEL2.TITCHE = 'RO ' 384 : MCHEL2.CONCHE(1) = ' ' 385 : C 386 : C**** Valeurs independente du repére, i.e. 387 : C 388 : MCHEL2.INFCHE(1,1) = 0 389 : MCHEL2.INFCHE(1,3) = NIFOUR 390 : MCHEL2.INFCHE(1,4) = 0 391 : MCHEL2.INFCHE(1,5) = 0 392 : MCHEL2.INFCHE(1,6) = 0 393 : MCHEL2.IFOCHE = IFOUR 394 : N2 = 1 395 : SEGINI MCHAM1 396 : MCHEL2.ICHAML(1) = MCHAM1 397 : SEGDES MCHEL2 398 : MCHAM1.NOMCHE(1) = 'SCAL ' 399 : MCHAM1.TYPCHE(1) = 'REAL*8 ' 400 : SEGINI MELRO 401 : MCHAM1.IELVAL(1) = MELRO 402 : SEGDES MCHAM1 403 : C 404 : C**** Pression 405 : C 406 : MCHEL1 = IROF 407 : SEGINI, MCHEL2 = MCHEL1 408 : IPF = MCHEL2 409 : MCHEL2.TITCHE = 'P ' 410 : C 411 : C**** MCHAM1 = MCHAML de la densite 412 : C 413 : SEGINI, MCHAM2 = MCHAM1 414 : MCHEL2.ICHAML(1) = MCHAM2 415 : SEGDES MCHEL2 416 : SEGINI MELP 417 : MCHAM2.IELVAL(1) = MELP 418 : SEGDES MCHAM2 419 : C 420 : C**** Gamma 421 : C 422 : MCHEL1 = IROF 423 : SEGINI, MCHEL2 = MCHEL1 424 : IGAMF = MCHEL2 425 : MCHEL2.TITCHE = 'GAMMA ' 426 : C 427 : C**** MCHAM1 = MCHAML de la densite 428 : C 429 : SEGINI, MCHAM2 = MCHAM1 430 : MCHEL2.ICHAML(1) = MCHAM2 431 : SEGDES MCHEL2 432 : SEGINI MELGAM 433 : MCHAM2.IELVAL(1) = MELGAM 434 : SEGDES MCHAM2 435 : C 436 : C**** Recapitulatif: les MELVALs et les MPOVALs actives 437 : C 438 : C MELVNX, MELVNY 439 : C MELT1X, MELT1Y 440 : C 441 : C MELVUN, MELVUT -> vitesse 442 : C 443 : C MELRO -> densite 444 : C 445 : C MELP -> pression 446 : C 447 : C MELGAM -> gamma 448 : C 449 : C MPROC, MPROP -> densite 450 : C 451 : C MPVITC, MPVITP -> vitesse 452 : C 453 : C MPPC, MPPP -> pression 454 : C 455 : C MPGAMC -> gamma 456 : C 457 : C MPNORM -> normales aux faces 458 : C 459 : C 460 : C*********************************************************************** 461 : C********* PREDICTION ************************************************** 462 : C*********************************************************************** 463 : C 464 : IF(LOGTEM)THEN 465 : C 466 : IPT3 = ICEN 467 : SEGACT IPT3 468 : NCEN = IPT3.NUM(/2) 469 : DO NLCE = 1, NCEN 470 : IF(LOGALP)THEN 471 : C 472 : C************* Gradients limités 473 : C 474 : ALPHA(1) = MELALR.VPOCHA(NLCE,1) 475 : ALPHA(2) = MELALV.VPOCHA(NLCE,1) 476 : ALPHA(3) = MELALV.VPOCHA(NLCE,2) 477 : ALPHA(4) = MELALP.VPOCHA(NLCE,1) 478 : ELSE 479 : C 480 : C************* Gradients non limités 481 : C 482 : ALPHA(1) = 1.0D0 483 : ALPHA(2) = 1.0D0 484 : ALPHA(3) = 1.0D0 485 : ALPHA(4) = 1.0D0 486 : ENDIF 487 : ROG = MPROP.VPOCHA(NLCE,1) 488 : UXG = MPVITP.VPOCHA(NLCE,1) 489 : UYG = MPVITP.VPOCHA(NLCE,2) 490 : PG = MPPP.VPOCHA(NLCE,1) 491 : DROX = MPGRR.VPOCHA(NLCE,1)*ALPHA(1) 492 : DROY = MPGRR.VPOCHA(NLCE,2)*ALPHA(1) 493 : DUXX = MPGRV.VPOCHA(NLCE,1)*ALPHA(2) 494 : DUXY = MPGRV.VPOCHA(NLCE,2)*ALPHA(2) 495 : DUYX = MPGRV.VPOCHA(NLCE,3)*ALPHA(3) 496 : DUYY = MPGRV.VPOCHA(NLCE,4)*ALPHA(3) 497 : DPX = MPGRP.VPOCHA(NLCE,1)*ALPHA(4) 498 : DPY = MPGRP.VPOCHA(NLCE,2)*ALPHA(4) 499 : GAMG = MPGAMC.VPOCHA(NLCE,1) 500 : DRO = UXG * DROX + ROG * ( DUXX + DUYY ) 501 : & + UYG * DROY 502 : DUX = UXG * DUXX + DPX / ROG + UYG * DUXY 503 : DUY = UXG * DUYX + UYG * DUYY + DPY / ROG 504 : DP = GAMG * PG * (DUXX + DUYY) 505 : & + UXG * DPX + UYG * DPY 506 : C 507 : C************* Prediction avec/sans gradients limités 508 : C 509 : MPROP.VPOCHA(NLCE,1) = ROG - DELTAT * DRO 510 : MPVITP.VPOCHA(NLCE,1) = UXG - DELTAT * DUX 511 : MPVITP.VPOCHA(NLCE,2) = UYG - DELTAT * DUY 512 : MPPP.VPOCHA(NLCE,1) = PG - DELTAT * DP 513 : ENDDO 514 : C 515 : ENDIF 516 : C 517 : C 518 : C*********************************************************************** 519 : C********* CORRECTION ************************************************** 520 : C*********************************************************************** 521 : C 522 : C**** Boucle sur le faces 523 : C 524 : IDIMP1 = IDIM + 1 525 : DO NLCF = 1, NFAC 526 : C 527 : C******* NLCF = numero local du centre de face 528 : C NGCF = numero global du centre de face 529 : C NGCEG = numero global du centre ELT "gauche" 530 : C NLCEG = numero local du centre ELT "gauche" 531 : C NGCED = numero global du centre ELT "droite" 532 : C NLCED = numero local du centre ELT "droite" 533 : C 534 : NGCEG = IPT1.NUM(1,NLCF) 535 : NGCF = IPT1.NUM(2,NLCF) 536 : NGCED = IPT1.NUM(3,NLCF) 537 : NLCEG = MLENT1.LECT(NGCEG) 538 : NLCED = MLENT1.LECT(NGCED) 539 : C 540 : C******* TEST: IPT2.NUM(1,NLCF) = IPT1.NUM(2,NLCF) 541 : C 542 : NGCF1 = IPT2.NUM(1,NLCF) 543 : IF( NGCF1 .NE. NGCF) THEN 544 : LOGAN = .TRUE. 545 : MESERR(1:40) = 'PRET, subroutine pre121.eso ' 546 : GOTO 9999 547 : ENDIF 548 : C 549 : C******* Cosinus directeurs des NORMALES aux faces 550 : C 551 : C On impose que les normales sont direct "Gauche" -> "Centre" 552 : C 553 : INDCEL = (NGCEG-1)*IDIMP1 554 : XG = XCOOR(INDCEL+1) 555 : YG = XCOOR(INDCEL+2) 556 : INDCEL = (NGCF-1)*IDIMP1 557 : XC = XCOOR(INDCEL + 1) 558 : YC = XCOOR(INDCEL + 2) 559 : INDCEL = (NGCED-1)*IDIMP1 560 : XD = XCOOR(INDCEL+1) 561 : YD = XCOOR(INDCEL+2) 562 : DXG = XC - XG 563 : DYG = YC - YG 564 : DXD = XC - XD 565 : DYD = YC - YD 566 : C 567 : C******* On calcule le sign du pruduit scalare 568 : C (Normales de Castem) * (vecteur "gauche" -> "centre") 569 : C 570 : CNX = MPNORM.VPOCHA(NLCF,1) 571 : CNY = MPNORM.VPOCHA(NLCF,2) 572 : ORIENT = CNX * DXG + CNY * DYG 573 : ORIENT = SIGN(1.0D0,ORIENT) 574 : IF(ORIENT .NE. 1.0D0)THEN 575 : LOGAN = .TRUE. 576 : MESERR(1:30)= 577 : & 'PRET , subroutine pre121.eso. ' 578 : GOTO 9999 579 : ENDIF 580 : CNX = CNX * ORIENT 581 : CNY = CNY * ORIENT 582 : C 583 : C********** Cosinus directeurs de tangent 2D 584 : C 585 : CTX = -1.0D0 * CNY 586 : CTY = CNX 587 : C 588 : C 589 : C******* Les autres MELVALs 590 : C 591 : C 592 : C******* N.B.: On suppose qu'on a déjà controlle RO, P > 0 593 : C GAMMA \in (1,3) 594 : C Si non il faut le faire, en utilisant LOGBOR, 595 : C LOGNEG, VALER, VAL1, VAL2 596 : C 597 : C 598 : C 599 : C******* NGCEG = NGCED -> Mur 600 : C 601 : IF( NGCEG .EQ. NGCED)THEN 602 : C 603 : C********** Sur le mur on fait de reconstruction sur l'etat gauche 604 : C 605 : C 606 : C********** Etat gauche 607 : C 608 : VALCEL = MPROP.VPOCHA(NLCEG, 1) 609 : ALCEL = MELALR.VPOCHA(NLCEG, 1) 610 : DCEL = MPGRR.VPOCHA(NLCEG, 1)*DXG + 611 : & MPGRR.VPOCHA(NLCEG, 2)*DYG 612 : ROG = VALCEL + ALCEL * DCEL 613 : C 614 : VALCEL = MPPP.VPOCHA(NLCEG, 1) 615 : ALCEL = MELALP.VPOCHA(NLCEG, 1) 616 : DCEL = MPGRP.VPOCHA(NLCEG, 1)*DXG + 617 : & MPGRP.VPOCHA(NLCEG, 2)*DYG 618 : PG = VALCEL + ALCEL * DCEL 619 : C 620 : GAMG = MPGAMC.VPOCHA(NLCEG, 1) 621 : C 622 : VALCEL = MPVITP.VPOCHA(NLCEG, 1) 623 : ALCEL = MELALV.VPOCHA(NLCEG, 1) 624 : DCEL = MPGRV.VPOCHA(NLCEG, 1)*DXG + 625 : & MPGRV.VPOCHA(NLCEG, 2)*DYG 626 : UXG = VALCEL + ALCEL * DCEL 627 : C 628 : VALCEL = MPVITP.VPOCHA(NLCEG, 2) 629 : ALCEL = MELALV.VPOCHA(NLCEG, 2) 630 : DCEL = MPGRV.VPOCHA(NLCEG, 3)*DXG + 631 : & MPGRV.VPOCHA(NLCEG, 4)*DYG 632 : UYG = VALCEL + ALCEL * DCEL 633 : C 634 : UNG = UXG * CNX + UYG * CNY 635 : UTG = UXG * CTX + UYG * CTY 636 : C 637 : C********** Si l'on fait pas de prediction, ce n'est pas necessaire de 638 : C controller la positivite' de la pression et de la densité; elle 639 : C est déjà garantie par la proprieté LED de limiteur; mais, vu 640 : C que le limiteur n'est pas calculé ici, mais dans un autre 641 : C operateur, on le fait 642 : C 643 : LOGI1 = (PG .LT. 0.0D0) .OR. (ROG .LT. 0.0D0) 644 : C 645 : IF(LOGI1)THEN 646 : C 647 : C************* Premier ordre en espace local 648 : C 649 : ROG = MPROC.VPOCHA(NLCEG,1) 650 : PG = MPPC.VPOCHA(NLCEG,1) 651 : UNG = MPVITC.VPOCHA(NLCEG,1)*CNX + 652 : & MPVITC.VPOCHA(NLCEG,2)*CNY 653 : UTG = MPVITC.VPOCHA(NLCEG,1)*CTX + 654 : & MPVITC.VPOCHA(NLCEG,2)*CTY 655 : ENDIF 656 : C 657 : C********** Son etat droite 658 : C 659 : ROD = ROG 660 : PD = PG 661 : GAMD = GAMG 662 : UND = -1.0D0 * UNG 663 : UTD = UTG 664 : C 665 : C************* Fin cas mur 666 : C 667 : ELSE 668 : C 669 : C************* Etat gauche 670 : C 671 : VALCEL = MPROP.VPOCHA(NLCEG, 1) 672 : ALCEL = MELALR.VPOCHA(NLCEG, 1) 673 : DCEL = MPGRR.VPOCHA(NLCEG, 1)*DXG + 674 : & MPGRR.VPOCHA(NLCEG, 2)*DYG 675 : ROG = VALCEL + ALCEL * DCEL 676 : C 677 : VALCEL = MPPP.VPOCHA(NLCEG, 1) 678 : ALCEL = MELALP.VPOCHA(NLCEG, 1) 679 : DCEL = MPGRP.VPOCHA(NLCEG, 1)*DXG + 680 : & MPGRP.VPOCHA(NLCEG, 2)*DYG 681 : PG = VALCEL + ALCEL * DCEL 682 : C 683 : GAMG = MPGAMC.VPOCHA(NLCEG, 1) 684 : C 685 : VALCEL = MPVITP.VPOCHA(NLCEG, 1) 686 : ALCEL = MELALV.VPOCHA(NLCEG, 1) 687 : DCEL = MPGRV.VPOCHA(NLCEG, 1)*DXG + 688 : & MPGRV.VPOCHA(NLCEG, 2)*DYG 689 : UXG = VALCEL + ALCEL * DCEL 690 : C 691 : VALCEL = MPVITP.VPOCHA(NLCEG, 2) 692 : ALCEL = MELALV.VPOCHA(NLCEG, 2) 693 : DCEL = MPGRV.VPOCHA(NLCEG, 3)*DXG + 694 : & MPGRV.VPOCHA(NLCEG, 4)*DYG 695 : UYG = VALCEL + ALCEL * DCEL 696 : C 697 : UNG = UXG * CNX + UYG * CNY 698 : UTG = UXG * CTX + UYG * CTY 699 : C 700 : C********** Positivite 701 : C 702 : LOGI1 = (PG .LT. 0.0D0) .OR. (ROG .LT. 0.0D0) 703 : C 704 : IF(LOGI1)THEN 705 : C 706 : C************* Premier ordre en espace local 707 : C 708 : ROG = MPROC.VPOCHA(NLCEG,1) 709 : PG = MPPC.VPOCHA(NLCEG,1) 710 : UNG = MPVITC.VPOCHA(NLCEG,1)*CNX + 711 : & MPVITC.VPOCHA(NLCEG,2)*CNY 712 : UTG = MPVITC.VPOCHA(NLCEG,1)*CTX + 713 : & MPVITC.VPOCHA(NLCEG,2)*CTY 714 : ENDIF 715 : C 716 : C********** Etat droite 717 : C 718 : VALCEL = MPROP.VPOCHA(NLCED, 1) 719 : ALCEL = MELALR.VPOCHA(NLCED, 1) 720 : DCEL = MPGRR.VPOCHA(NLCED, 1)*DXD + 721 : & MPGRR.VPOCHA(NLCED, 2)*DYD 722 : ROD = VALCEL + ALCEL * DCEL 723 : C 724 : VALCEL = MPPP.VPOCHA(NLCED, 1) 725 : ALCEL = MELALP.VPOCHA(NLCED, 1) 726 : DCEL = MPGRP.VPOCHA(NLCED, 1)*DXD + 727 : & MPGRP.VPOCHA(NLCED, 2)*DYD 728 : PD = VALCEL + ALCEL * DCEL 729 : C 730 : GAMD = MPGAMC.VPOCHA(NLCED, 1) 731 : C 732 : VALCEL = MPVITP.VPOCHA(NLCED, 1) 733 : ALCEL = MELALV.VPOCHA(NLCED, 1) 734 : DCEL = MPGRV.VPOCHA(NLCED, 1)*DXD + 735 : & MPGRV.VPOCHA(NLCED, 2)*DYD 736 : UXD = VALCEL + ALCEL * DCEL 737 : C 738 : VALCEL = MPVITP.VPOCHA(NLCED, 2) 739 : ALCEL = MELALV.VPOCHA(NLCED, 2) 740 : DCEL = MPGRV.VPOCHA(NLCED, 3)*DXD + 741 : & MPGRV.VPOCHA(NLCED, 4)*DYD 742 : UYD = VALCEL + ALCEL * DCEL 743 : C 744 : UND = UXD * CNX + UYD * CNY 745 : UTD = UXD * CTX + UYD * CTY 746 : C 747 : C********** Positivite 748 : C 749 : LOGI1 = (PD .LT. 0.0D0) .OR. (ROD .LT. 0.0D0) 750 : C 751 : IF(LOGI1)THEN 752 : C 753 : C************* Premier ordre en espace local 754 : C 755 : ROD = MPROC.VPOCHA(NLCED,1) 756 : PD = MPPC.VPOCHA(NLCED,1) 757 : UND = MPVITC.VPOCHA(NLCED,1)*CNX + 758 : & MPVITC.VPOCHA(NLCED,2)*CNY 759 : UTD = MPVITC.VPOCHA(NLCED,1)*CTX + 760 : & MPVITC.VPOCHA(NLCED,2)*CTY 761 : ENDIF 762 : ENDIF 763 : C 764 : C******** Les MELVALs 765 : C 766 : MELRO.VELCHE(1,NLCF) = ROG 767 : MELRO.VELCHE(3,NLCF) = ROD 768 : MELP.VELCHE(1,NLCF) = PG 769 : MELP.VELCHE(3,NLCF) = PD 770 : MELGAM.VELCHE(1,NLCF) = GAMG 771 : MELGAM.VELCHE(3,NLCF) = GAMD 772 : MELVUN.VELCHE(1,NLCF) = UNG 773 : MELVUN.VELCHE(3,NLCF) = UND 774 : MELVUT.VELCHE(1,NLCF) = UTG 775 : MELVUT.VELCHE(3,NLCF) = UTD 776 : MELVNX.VELCHE(1,NLCF) = CNX 777 : MELVNY.VELCHE(1,NLCF) = CNY 778 : MELT1X.VELCHE(1,NLCF) = CTX 779 : MELT1Y.VELCHE(1,NLCF) = CTY 780 : C 781 : ENDDO 782 : C 783 : C**** Desactivation des SEGMENTs 784 : C 785 : SEGDES IPT1 786 : SEGDES IPT2 787 : C 788 : C**** Le MPOVALs 'Prediction' sont detruits (si existentes) 789 : C 790 : IF(LOGTEM)THEN 791 : SEGSUP MPROP 792 : SEGSUP MPVITP 793 : SEGSUP MPPP 794 : ENDIF 795 : C 796 : SEGDES MPROC 797 : SEGDES MPGRR 798 : SEGDES MELALR 799 : SEGDES MPVITC 800 : SEGDES MPGRV 801 : SEGDES MELALV 802 : SEGDES MPPC 803 : SEGDES MPGRP 804 : SEGDES MELALP 805 : SEGDES MPGAMC 806 : SEGDES MPNORM 807 : C 808 : SEGDES MELRO 809 : SEGDES MELP 810 : SEGDES MELGAM 811 : SEGDES MELVUN 812 : SEGDES MELVUT 813 : SEGDES MELVNX 814 : SEGDES MELVNY 815 : SEGDES MELT1X 816 : SEGDES MELT1Y 817 : C 818 : C 819 : C**** Destruction du MELNTI correspondance local/global 820 : C 821 : SEGSUP MLENT1 822 : C 823 : 9999 CONTINUE 824 : C 825 : RETURN 826 : END 827 : 828 : 829 : 830 : 831 : 832 : 833 : 834 :
© Cast3M 2003 - All rights reserved.
Disclaimer