1 : C PRE611 SOURCE BECC 11/01/05 21:15:16 6836 2 : SUBROUTINE PRE611(ICEN,IFACE,IFACEL,INORM, 3 : & IAL1, IGRAL1, ILIAL1, 4 : & IAL2, IGRAL2, ILIAL2, 5 : & IRN1, IGRRN1, ILIRN1, 6 : & IRN2, IGRRN2, ILIRN2, 7 : & IVN1, IGRVN1, ILIVN1, 8 : & IVN2, IGRVN2, ILIVN2, 9 : & IPN1, IGRPN1, ILIPN1, 10 : & IPN2, IGRPN2, ILIPN2, 11 : & IAL1F, IAL2F, IRN1F, IRN2F, IVN1F, IVN2F, IPN1F, IPN2F) 12 : C************************************************************************ 13 : C 14 : C PROJET : CASTEM 2000 15 : C 16 : C NOM : PRE611 17 : C 18 : C DESCRIPTION : Voir PRE61 19 : C 20 : C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI) 21 : C 22 : C AUTEUR : A. BECCANTINI, DEN/DM2S/SFME/LTMF 23 : C 24 : C************************************************************************ 25 : C 26 : C ENTREES 27 : C 28 : C 29 : C 1) Pointeurs de MELEMEs et de CHPOINTs de la table DOMAINE 30 : C 31 : C ICEN : MELEME de 'POI1' SPG des CENTRES 32 : C 33 : C IFACE : MELEME de 'POI1' SPG des FACES 34 : C 35 : C IFACEL : MELEME de 'SEG3' avec 36 : C CENTRE d'Elt "gauche" 37 : C CENTRE de Face 38 : C CENTRE d'Elt "droite" 39 : C 40 : C N.B. = IFACE.NUM(i,1) = IFACEL.NUM(i,2) 41 : C 42 : C INORM : CHPOINT des cosinus directeurs de normales aux faces 43 : C 44 : C 2) Autres pointeurs 45 : C 46 : C IAL1, IGRAL1, ILIAL1, 47 : C IAL2, IGRAL2, ILIAL2. 48 : C CHPOINT "CENTRE" de fractions volumiques, gradients et limiteurs 49 : C 50 : C IRN1, IGRRN1, ILIRN1, 51 : C IRN2, IGRRN2, ILIRN2. 52 : C CHPOINT "CENTRE" de densités, gradients et limiteurs 53 : C 54 : C IVN1, IGRVN1, ILIVN1, 55 : C IVN2, IGRVN2, ILIVN2. 56 : C CHPOINT "CENTRE" de vitesses, gradients et limiteurs 57 : C 58 : C IPN1, IGRPN1, ILIPN1, 59 : C IPN2, IGRPN2, ILIPN2. 60 : C CHPOINT "CENTRE" de pression, gradients et limiteurs 61 : C 62 : C 63 : C SORTIES 64 : C 65 : C IAL1F, IAL2F, IRN1F, IRN2F, IVN1F, IVN2F, IPN1F, IPN2F. 66 : C MCHAMLs definis sur le MELEME de pointeur IFACEL 67 : C 68 : C************************************************************************ 69 : C 70 : C HISTORIQUE (Anomalies et modifications éventuelles) 71 : C 72 : C HISTORIQUE : Crée le 03.12.09. 73 : C Estension au 3D le 21.12.2010 74 : C 75 : C************************************************************************ 76 : C 77 : C 78 : C ATTENTION: Cet programme marche si le MAILLAGE est convex; 79 : C si non il faut changer l'algoritme de calcul de 80 : C l'orientation des normales aux faces. 81 : C 82 : C La positivité n'est pas controlle parce que c'est déjà fait 83 : C dans l'operateur PRIM 84 : C 85 : C 86 : C************************************************************************ 87 : C 88 : IMPLICIT INTEGER(I-N) 89 : C 90 : C**** Les variables 91 : C 92 : INTEGER IAL1, IGRAL1, ILIAL1 93 : & , IAL2, IGRAL2, ILIAL2 94 : & , IRN1, IGRRN1, ILIRN1 95 : & , IRN2, IGRRN2, ILIRN2 96 : & , IVN1, IGRVN1, ILIVN1 97 : & , IVN2, IGRVN2, ILIVN2 98 : & , IPN1, IGRPN1, ILIPN1 99 : & , IPN2, IGRPN2, ILIPN2 100 : & , IAL1F, IAL2F, IRN1F, IRN2F 101 : & , IVN1F, IVN2F, IPN1F, IPN2F 102 : & , IGEOM, NFAC, NCEN 103 : & , N1PTEL, N1EL, N2PTEL, N2EL, N2, N1, N3, L1 104 : & , NLCF, NGCF, NGCEG, NLCEG, NGCED, NLCED, NGCF1 105 : & , IDIMP1, INDCEL 106 : REAL*8 XG, YG, ZG, XC, YC, ZC, XD, YD, ZD 107 : & ,DXG, DYG, DZG, DXD, DYD, DZD 108 : & , CNX, CNY, CNZ, CTX, CTY, CTZ, ORIENT 109 : & , CVX, CVY, CVZ 110 : & , AL1G, AL2G, RN1G, RN2G, PN1G, PN2G 111 : & , UX1G, UX2G, UY1G, UY2G, UZ1G, UZ2G 112 : & , UN1G, UN2G, UT1G, UT2G, UV1G, UV2G 113 : & , AL1D, AL2D, RN1D, RN2D, PN1D, PN2D 114 : & , UX1D, UX2D, UY1D, UY2D, UZ1D, UZ2D 115 : & , UN1D, UN2D, UT1D, UT2D, UV1D, UV2D 116 : & , VALCEL, DCEL, LIMCEL 117 : CHARACTER*(40) MESERR 118 : CHARACTER*(8) TYPE 119 : LOGICAL LOGI1 120 : C 121 : C**** Les Includes 122 : C 123 : -INC SMCOORD 124 : -INC CCOPTIO 125 : -INC SMCHPOI 126 : POINTEUR MPAL1.MPOVAL, MPGAL1.MPOVAL, MPLAL1.MPOVAL 127 : POINTEUR MPAL2.MPOVAL, MPGAL2.MPOVAL, MPLAL2.MPOVAL 128 : POINTEUR MPRN1.MPOVAL, MPGRN1.MPOVAL, MPLRN1.MPOVAL 129 : POINTEUR MPRN2.MPOVAL, MPGRN2.MPOVAL, MPLRN2.MPOVAL 130 : POINTEUR MPVN1.MPOVAL, MPGVN1.MPOVAL, MPLVN1.MPOVAL 131 : POINTEUR MPVN2.MPOVAL, MPGVN2.MPOVAL, MPLVN2.MPOVAL 132 : POINTEUR MPPN1.MPOVAL, MPGPN1.MPOVAL, MPLPN1.MPOVAL 133 : POINTEUR MPPN2.MPOVAL, MPGPN2.MPOVAL, MPLPN2.MPOVAL 134 : POINTEUR MPNORM.MPOVAL 135 : -INC SMCHAML 136 : C Melval des cosinus directeurs 137 : POINTEUR MELVNX.MELVAL, MELVNY.MELVAL, MELVNZ.MELVAL, 138 : & MELT1X.MELVAL, MELT1Y.MELVAL, MELT1Z.MELVAL, 139 : & MELT2X.MELVAL, MELT2Y.MELVAL, MELT2Z.MELVAL 140 : C Melval des vitesses 141 : POINTEUR MEVUN1.MELVAL, MEVUT1.MELVAL, MEVUV1.MELVAL, 142 : & MEVUN2.MELVAL, MEVUT2.MELVAL, MEVUV2.MELVAL 143 : C Melval des densités, pressions, alphas 144 : POINTEUR MELRN1.MELVAL, MELRN2.MELVAL 145 : POINTEUR MELPN1.MELVAL, MELPN2.MELVAL 146 : POINTEUR MELAL1.MELVAL, MELAL2.MELVAL 147 : -INC SMLENTI 148 : -INC SMELEME 149 : C 150 : C**** KRIPAD pour la correspondance global/local de centre 151 : C 151 : CALL KRIPAD(ICEN,MLENT1) 152 : C 153 : C**** MLENTI1 a MCORD.XCOORD(/1)/(IDIM+1) elements 154 : C 155 : C Si i est le numero global d'un noeud de ICEN, 156 : C MLENT1.LECT(i) contient sa position, i.e. 157 : C 158 : C I = numero global du noeud centre 159 : C MLENT1.LECT(i) = numero local du noeud centre 160 : C 161 : C MLENT1 déjà activé, i.e. 162 : C 163 : C SEGACT MLENT1 164 : C 165 : C**** Activation de CHPOINTs 166 : C 167 : C alpha + grad + limiteur 168 : C densité + grad + limiteur 169 : C vitesse + grad + limiteur 170 : C pression + grad + limiteur 171 : C cosinus directeurs des normales aux surface 172 : C 172 : CALL LICHT(IAL1 , MPAL1 , TYPE, IGEOM) 173 : C SEGACT MPAL1 173 : CALL LICHT(IGRAL1 , MPGAL1 , TYPE, IGEOM) 174 : C SEGACT MPGAL1 174 : CALL LICHT(ILIAL1 , MPLAL1 , TYPE, IGEOM) 175 : C SEGACT MPLAL1 175 : CALL LICHT(IAL2 , MPAL2 , TYPE, IGEOM) 176 : C SEGACT MPAL2 176 : CALL LICHT(IGRAL2 , MPGAL2 , TYPE, IGEOM) 177 : C SEGACT MPGAL2 177 : CALL LICHT(ILIAL2 , MPLAL2 , TYPE, IGEOM) 178 : C SEGACT MPLAL2 178 : CALL LICHT(IRN1 , MPRN1 , TYPE, IGEOM) 179 : C SEGACT MPRN1 179 : CALL LICHT(IGRRN1 , MPGRN1 , TYPE, IGEOM) 180 : C SEGACT MPGRN1 180 : CALL LICHT(ILIRN1 , MPLRN1 , TYPE, IGEOM) 181 : C SEGACT MPLRN1 181 : CALL LICHT(IRN2 , MPRN2 , TYPE, IGEOM) 182 : C SEGACT MPRN2 182 : CALL LICHT(IGRRN2 , MPGRN2 , TYPE, IGEOM) 183 : C SEGACT MPGRN2 183 : CALL LICHT(ILIRN2 , MPLRN2 , TYPE, IGEOM) 184 : C SEGACT MPLRN2 184 : CALL LICHT(IVN1 , MPVN1 , TYPE, IGEOM) 185 : C SEGACT MPVN1 185 : CALL LICHT(IGRVN1 , MPGVN1 , TYPE, IGEOM) 186 : C SEGACT MPGVN1 186 : CALL LICHT(ILIVN1 , MPLVN1 , TYPE, IGEOM) 187 : C SEGACT MPLVN1 187 : CALL LICHT(IVN2 , MPVN2 , TYPE, IGEOM) 188 : C SEGACT MPVN2 188 : CALL LICHT(IGRVN2 , MPGVN2 , TYPE, IGEOM) 189 : C SEGACT MPGVN2 189 : CALL LICHT(ILIVN2 , MPLVN2 , TYPE, IGEOM) 190 : C SEGACT MPLVN2 190 : CALL LICHT(IPN1 , MPPN1 , TYPE, IGEOM) 191 : C SEGACT MPPN1 191 : CALL LICHT(IGRPN1 , MPGPN1 , TYPE, IGEOM) 192 : C SEGACT MPGPN1 192 : CALL LICHT(ILIPN1 , MPLPN1 , TYPE, IGEOM) 193 : C SEGACT MPLPN1 193 : CALL LICHT(IPN2 , MPPN2 , TYPE, IGEOM) 194 : C SEGACT MPPN2 194 : CALL LICHT(IGRPN2 , MPGPN2 , TYPE, IGEOM) 195 : C SEGACT MPGPN2 195 : CALL LICHT(ILIPN2 , MPLPN2 , TYPE, IGEOM) 196 : C SEGACT MPLPN2 197 : C 198 : C**** Le cosinus directeurs 199 : C 199 : CALL LICHT(INORM , MPNORM , TYPE, IGEOM) 200 : C SEGACT MPNORM 201 : C 202 : C**** Les MPOVAL sont déjà activés i.e.: 203 : C 204 : C 205 : C**** Le MELEME FACEL 206 : C 207 : IPT1 = IFACEL 208 : IPT2 = IFACE 209 : SEGACT IPT1 210 : SEGACT IPT2 211 : NFAC = IPT1.NUM(/2) 212 : C 213 : C**** Creation de MCHAMLs contenant les etats gauche et droite, 214 : C 215 : C i.e.: 216 : C 217 : C vitesse + cosinus directors du repere local 218 : C alpha 219 : C densité 220 : C pression 221 : C 222 : C********************************************************** 223 : C**** Cosinus directors du repere local et vitesse ******** 224 : C********************************************************** 225 : C 226 : C Les cosinus directeurs 227 : C 228 : N1 = 2 229 : N3 = 6 230 : L1 = 28 231 : SEGINI MCHEL1 232 : IVN1F = MCHEL1 233 : MCHEL1.TITCHE = 'U ' 234 : MCHEL1.IMACHE(1) = IFACE 235 : MCHEL1.IMACHE(2) = IFACEL 236 : IF (IDIM .EQ. 2) THEN 237 : MCHEL1.CONCHE(1) = '(n,t) in (x,y) ' 238 : MCHEL1.CONCHE(2) = ' U in (n,t) ' 239 : ELSE 240 : MCHEL1.CONCHE(1) = '(n,t,v)in(x,y,z)' 241 : MCHEL1.CONCHE(2) = ' U in (n,t,v) ' 242 : ENDIF 243 : * MCHEL1.NOPHAS(1) = ' ' 244 : * MCHEL1.NOPHAS(2) = ' ' 245 : C 246 : C**** Valeurs des cosinus definies par respect au repair global, i.e. 247 : C 248 : MCHEL1.INFCHE(1,1) = 2 249 : MCHEL1.INFCHE(1,3) = NIFOUR 250 : MCHEL1.INFCHE(1,4) = 0 251 : MCHEL1.INFCHE(1,5) = 0 252 : MCHEL1.INFCHE(1,6) = 0 253 : MCHEL1.IFOCHE = IFOUR 254 : C 255 : C**** Valeurs de vitesse definies par respect au repair local, i.e. 256 : C 257 : MCHEL1.INFCHE(2,1) = 1 258 : MCHEL1.INFCHE(2,3) = NIFOUR 259 : MCHEL1.INFCHE(2,4) = 0 260 : MCHEL1.INFCHE(2,5) = 0 261 : MCHEL1.INFCHE(2,6) = 0 262 : C 263 : C**** Le cosinus directeurs 264 : C 265 : N1PTEL = 1 266 : N1EL = NFAC 267 : N2PTEL = 0 268 : N2EL = 0 269 : C 270 : C**** MCHAML a N2 composantes: 271 : C 272 : C cosinus directeurs du repere local (n,t1) 273 : C 274 : C IDIM = 3 -> 9 composantes 275 : C IDIM = 2 -> 4 composantes 276 : C 277 : IF (IDIM .EQ. 2)THEN 278 : N2 = 4 279 : SEGINI MCHAM1 280 : MCHEL1.ICHAML(1) = MCHAM1 281 : MCHAM1.NOMCHE(1) = 'NX ' 282 : MCHAM1.NOMCHE(2) = 'NY ' 283 : MCHAM1.NOMCHE(3) = 'TX ' 284 : MCHAM1.NOMCHE(4) = 'TY ' 285 : MCHAM1.TYPCHE(1) = 'REAL*8 ' 286 : MCHAM1.TYPCHE(2) = 'REAL*8 ' 287 : MCHAM1.TYPCHE(3) = 'REAL*8 ' 288 : MCHAM1.TYPCHE(4) = 'REAL*8 ' 289 : SEGINI MELVNX 290 : SEGINI MELVNY 291 : SEGINI MELT1X 292 : SEGINI MELT1Y 293 : MCHAM1.IELVAL(1) = MELVNX 294 : MCHAM1.IELVAL(2) = MELVNY 295 : MCHAM1.IELVAL(3) = MELT1X 296 : MCHAM1.IELVAL(4) = MELT1Y 297 : SEGDES MCHAM1 298 : ELSEIF (IDIM .EQ. 3) THEN 299 : N2 = 9 300 : SEGINI MCHAM1 301 : MCHEL1.ICHAML(1) = MCHAM1 302 : MCHAM1.NOMCHE(1) = 'NX ' 303 : MCHAM1.NOMCHE(2) = 'NY ' 304 : MCHAM1.NOMCHE(3) = 'NZ ' 305 : MCHAM1.NOMCHE(4) = 'TX ' 306 : MCHAM1.NOMCHE(5) = 'TY ' 307 : MCHAM1.NOMCHE(6) = 'TZ ' 308 : MCHAM1.NOMCHE(7) = 'VX ' 309 : MCHAM1.NOMCHE(8) = 'VY ' 310 : MCHAM1.NOMCHE(9) = 'VZ ' 311 : MCHAM1.TYPCHE(1) = 'REAL*8 ' 312 : MCHAM1.TYPCHE(2) = 'REAL*8 ' 313 : MCHAM1.TYPCHE(3) = 'REAL*8 ' 314 : MCHAM1.TYPCHE(4) = 'REAL*8 ' 315 : MCHAM1.TYPCHE(5) = 'REAL*8 ' 316 : MCHAM1.TYPCHE(6) = 'REAL*8 ' 317 : MCHAM1.TYPCHE(7) = 'REAL*8 ' 318 : MCHAM1.TYPCHE(8) = 'REAL*8 ' 319 : MCHAM1.TYPCHE(9) = 'REAL*8 ' 320 : SEGINI MELVNX 321 : SEGINI MELVNY 322 : SEGINI MELVNZ 323 : SEGINI MELT1X 324 : SEGINI MELT1Y 325 : SEGINI MELT1Z 326 : SEGINI MELT2X 327 : SEGINI MELT2Y 328 : SEGINI MELT2Z 329 : MCHAM1.IELVAL(1) = MELVNX 330 : MCHAM1.IELVAL(2) = MELVNY 331 : MCHAM1.IELVAL(3) = MELVNZ 332 : MCHAM1.IELVAL(4) = MELT1X 333 : MCHAM1.IELVAL(5) = MELT1Y 334 : MCHAM1.IELVAL(6) = MELT1Z 335 : MCHAM1.IELVAL(7) = MELT2X 336 : MCHAM1.IELVAL(8) = MELT2Y 337 : MCHAM1.IELVAL(9) = MELT2Z 338 : SEGDES MCHAM1 339 : ENDIF 340 : C 341 : C**** Vitesse 342 : C 343 : N1EL = NFAC 344 : N1PTEL = 3 345 : N2EL = 0 346 : N2PTEL = 0 347 : C 348 : C**** MCHAML a N2 composantes: 349 : C 350 : C IDIM = 2 -> 2 composantes 351 : C IDIM = 3 -> 3 composantes 352 : C 353 : N2 = IDIM 354 : SEGINI MCHAM1 355 : MCHEL1.ICHAML(2) = MCHAM1 356 : MCHAM1.NOMCHE(1) = 'UN ' 357 : MCHAM1.NOMCHE(2) = 'UT ' 358 : MCHAM1.TYPCHE(1) = 'REAL*8 ' 359 : MCHAM1.TYPCHE(2) = 'REAL*8 ' 360 : SEGINI MEVUN1 361 : SEGINI MEVUT1 362 : MCHAM1.IELVAL(1) = MEVUN1 363 : MCHAM1.IELVAL(2) = MEVUT1 364 : SEGDES MCHAM1 365 : IF (IDIM .EQ. 3) THEN 366 : MCHAM1.NOMCHE(3) = 'UV ' 367 : MCHAM1.TYPCHE(3) = 'REAL*8 ' 368 : SEGINI MEVUV1 369 : MCHAM1.IELVAL(3) = MEVUV1 370 : ENDIF 371 : C 372 : C**** Vitesse 2 373 : C 374 : MCHEL1 = IVN1F 375 : SEGINI, MCHEL2 = MCHEL1 376 : IVN2F = MCHEL2 377 : C The MCHEL2.ICHAML(1) contiens le cosinus directeurs 378 : C => MCHEL2.ICHAML(1) = MCHEL1.ICHAML(1) 379 : MCHAM1 = MCHEL1.ICHAML(2) 380 : SEGDES MCHEL1 381 : SEGINI, MCHAM2 = MCHAM1 382 : MCHEL2.ICHAML(2) = MCHAM2 383 : SEGDES MCHEL2 384 : SEGINI, MEVUN2 = MEVUN1 385 : SEGINI, MEVUT2 = MEVUT1 386 : MCHAM2.IELVAL(1) = MEVUN2 387 : MCHAM2.IELVAL(2) = MEVUT2 388 : IF (IDIM .EQ. 3)THEN 389 : SEGINI, MEVUV2 = MEVUV1 390 : MCHAM2.IELVAL(3) = MEVUV2 391 : ENDIF 392 : SEGDES MCHAM2 393 : C 394 : C********************************************************** 395 : C**** Alpha1 and alpha2 ******** 396 : C********************************************************** 397 : C 398 : C**** Alpha1 399 : C 400 : N1 = 1 401 : N3 = 6 402 : L1 = 15 403 : SEGINI MCHEL2 404 : IAL1F = MCHEL2 405 : MCHEL2.IMACHE(1) = IFACEL 406 : MCHEL2.TITCHE = 'ALPHA1 ' 407 : MCHEL2.CONCHE(1) = ' ' 408 : * MCHEL2.NOPHAS(1) = ' ' 409 : C 410 : C**** Valeurs independente du repére, i.e. 411 : C 412 : MCHEL2.INFCHE(1,1) = 0 413 : MCHEL2.INFCHE(1,3) = NIFOUR 414 : MCHEL2.INFCHE(1,4) = 0 415 : MCHEL2.INFCHE(1,5) = 0 416 : MCHEL2.INFCHE(1,6) = 0 417 : MCHEL2.IFOCHE = IFOUR 418 : N2 = 1 419 : SEGINI MCHAM1 420 : MCHEL2.ICHAML(1) = MCHAM1 421 : C SEGDES MCHEL2 422 : MCHAM1.NOMCHE(1) = 'SCAL ' 423 : MCHAM1.TYPCHE(1) = 'REAL*8 ' 424 : SEGINI MELAL1 425 : MCHAM1.IELVAL(1) = MELAL1 426 : SEGDES MCHAM1 427 : C 428 : C**** Alpha2 429 : C 430 : MCHEL1 = IAL1F 431 : SEGINI, MCHEL2 = MCHEL1 432 : IAL2F = MCHEL2 433 : MCHEL2.TITCHE = 'ALPHA2 ' 434 : MCHAM1 = MCHEL1.ICHAML(1) 435 : SEGINI, MCHAM2 = MCHAM1 436 : MCHEL2.ICHAML(1) = MCHAM2 437 : SEGDES MCHEL2 438 : SEGINI MELAL2 439 : MCHAM2.IELVAL(1) = MELAL2 440 : SEGDES MCHAM2 441 : C 442 : C********************************************************** 443 : C**** IRN1F and IRN2F ******** 444 : C********************************************************** 445 : C 446 : MCHEL1 = IAL1F 447 : SEGINI, MCHEL2 = MCHEL1 448 : IRN1F = MCHEL2 449 : MCHEL2.TITCHE = 'RHO1 ' 450 : MCHAM1 = MCHEL1.ICHAML(1) 451 : SEGINI, MCHAM2 = MCHAM1 452 : MCHEL2.ICHAML(1) = MCHAM2 453 : SEGDES MCHEL2 454 : SEGINI MELRN1 455 : MCHAM2.IELVAL(1) = MELRN1 456 : SEGDES MCHAM2 457 : C 458 : C 459 : MCHEL1 = IAL1F 460 : SEGINI, MCHEL2 = MCHEL1 461 : IRN2F = MCHEL2 462 : MCHEL2.TITCHE = 'RHO2 ' 463 : MCHAM1 = MCHEL1.ICHAML(1) 464 : SEGINI, MCHAM2 = MCHAM1 465 : MCHEL2.ICHAML(1) = MCHAM2 466 : SEGDES MCHEL2 467 : SEGINI MELRN2 468 : MCHAM2.IELVAL(1) = MELRN2 469 : SEGDES MCHAM2 470 : C 471 : C 472 : C********************************************************** 473 : C**** IRN1F and IRN2F ******** 474 : C********************************************************** 475 : C 476 : MCHEL1 = IAL1F 477 : SEGINI, MCHEL2 = MCHEL1 478 : IPN1F = MCHEL2 479 : MCHEL2.TITCHE = 'P1 ' 480 : MCHAM1 = MCHEL1.ICHAML(1) 481 : SEGINI, MCHAM2 = MCHAM1 482 : MCHEL2.ICHAML(1) = MCHAM2 483 : SEGDES MCHEL2 484 : SEGINI MELPN1 485 : MCHAM2.IELVAL(1) = MELPN1 486 : SEGDES MCHAM2 487 : C 488 : C 489 : MCHEL1 = IAL1F 490 : SEGINI, MCHEL2 = MCHEL1 491 : IPN2F = MCHEL2 492 : MCHEL2.TITCHE = 'P2 ' 493 : MCHAM1 = MCHEL1.ICHAML(1) 494 : SEGINI, MCHAM2 = MCHAM1 495 : MCHEL2.ICHAML(1) = MCHAM2 496 : SEGDES MCHEL2 497 : SEGINI MELPN2 498 : MCHAM2.IELVAL(1) = MELPN2 499 : SEGDES MCHAM2 500 : SEGDES MCHEL1 501 : C 502 : C********************************************************** 503 : C**** Boucle sur le faces ********* 504 : C********************************************************** 505 : C 506 : CNZ = 0.0D0 507 : CTZ = 0.0D0 508 : DZG = 0.0D0 509 : DZD = 0.0D0 510 : CVX = 0.0D0 511 : CVY = 0.0D0 512 : CVZ = 0.0D0 513 : UZ1G = 0.0D0 514 : UZ1D = 0.0D0 515 : UZ2G = 0.0D0 516 : UZ2D = 0.0D0 517 : C 518 : IDIMP1 = IDIM + 1 519 : DO NLCF = 1, NFAC 520 : C 521 : C******* NLCF = numero local du centre de face 522 : C NGCF = numero global du centre de face 523 : C NGCEG = numero global du centre ELT "gauche" 524 : C NLCEG = numero local du centre ELT "gauche" 525 : C NGCED = numero global du centre ELT "droite" 526 : C NLCED = numero local du centre ELT "droite" 527 : C 528 : NGCEG = IPT1.NUM(1,NLCF) 529 : NGCF = IPT1.NUM(2,NLCF) 530 : NGCED = IPT1.NUM(3,NLCF) 531 : NLCEG = MLENT1.LECT(NGCEG) 532 : NLCED = MLENT1.LECT(NGCED) 533 : C 534 : C******* TEST: IPT2.NUM(1,NLCF) = IPT1.NUM(2,NLCF) 535 : C 536 : NGCF1 = IPT2.NUM(1,NLCF) 537 : IF( NGCF1 .NE. NGCF) THEN 538 : MESERR(1:40) = 'PRET, subroutine pre611.eso ' 539 : WRITE(IOIMP,*) MESERR 539 : CALL ERREUR(5) 540 : GOTO 9999 541 : ENDIF 542 : C 543 : C******* Cosinus directeurs des NORMALES aux faces 544 : C 545 : C On impose que les normales sont direct "Gauche" -> "Centre" 546 : C 547 : INDCEL = (NGCEG-1)*IDIMP1 548 : XG = XCOOR(INDCEL+1) 549 : YG = XCOOR(INDCEL+2) 550 : INDCEL = (NGCF-1)*IDIMP1 551 : XC = XCOOR(INDCEL + 1) 552 : YC = XCOOR(INDCEL + 2) 553 : INDCEL = (NGCED-1)*IDIMP1 554 : XD = XCOOR(INDCEL+1) 555 : YD = XCOOR(INDCEL+2) 556 : DXG = XC - XG 557 : DYG = YC - YG 558 : DXD = XC - XD 559 : DYD = YC - YD 560 : C 561 : C******* On calcule le sign du pruduit scalare 562 : C (Normales de Castem) * (vecteur "gauche" -> "centre") 563 : C 564 : CNX = MPNORM.VPOCHA(NLCF,1) 565 : CNY = MPNORM.VPOCHA(NLCF,2) 566 : ORIENT = CNX * DXG + CNY * DYG 567 : IF (IDIM .EQ. 3) THEN 568 : INDCEL = (NGCEG-1)*IDIMP1 569 : ZG = XCOOR(INDCEL+3) 570 : INDCEL = (NGCF-1)*IDIMP1 571 : ZC = XCOOR(INDCEL + 3) 572 : INDCEL = (NGCED-1)*IDIMP1 573 : ZD = XCOOR(INDCEL+3) 574 : DZG = ZC - ZG 575 : DZD = ZC - ZD 576 : C 577 : CNX = MPNORM.VPOCHA(NLCF,7) 578 : CNY = MPNORM.VPOCHA(NLCF,8) 579 : CNZ = MPNORM.VPOCHA(NLCF,9) 580 : ORIENT = (CNX * DXG) + (CNY * DYG) + (CNZ * DZG) 581 : ENDIF 582 : ORIENT = SIGN(1.0D0,ORIENT) 583 : IF(ORIENT .NE. 1.0D0)THEN 584 : MESERR(1:30)= 585 : & 'PRET , subroutine pre612.eso. ' 586 : GOTO 9999 587 : ENDIF 588 : CNX = CNX * ORIENT 589 : CNY = CNY * ORIENT 590 : CNZ = CNZ * ORIENT 591 : C 592 : C******* Cosinus directeurs de tangent 2D 593 : C 594 : CTX = -1.0D0 * CNY 595 : CTY = CNX 596 : IF (IDIM .EQ. 3) THEN 597 : C 598 : C********** Cosinus directeurs de tangente 1 599 : C 600 : CTX = MPNORM.VPOCHA(NLCF,1) * ORIENT 601 : CTY = MPNORM.VPOCHA(NLCF,2) * ORIENT 602 : CTZ = MPNORM.VPOCHA(NLCF,3) * ORIENT 603 : C 604 : C********** Cosinus directeurs de tangente 2 605 : C 606 : CVX = MPNORM.VPOCHA(NLCF,4) * ORIENT 607 : CVY = MPNORM.VPOCHA(NLCF,5) * ORIENT 608 : CVZ = MPNORM.VPOCHA(NLCF,6) * ORIENT 609 : C 610 : ENDIF 611 : C 612 : C******* Les autres MELVALs 613 : C 614 : C 615 : C******* N.B.: On suppose qu'on a déjà controlle RO, P > 0... 616 : C 617 : C 618 : C******* Etat gauche 619 : C 620 : C ALPHA 621 : C 622 : VALCEL = MPAL1.VPOCHA(NLCEG, 1) 623 : LIMCEL = MPLAL1.VPOCHA(NLCEG, 1) 624 : DCEL = (MPGAL1.VPOCHA(NLCEG, 1) * DXG) + 625 : & (MPGAL1.VPOCHA(NLCEG, 2) * DYG) 626 : IF (IDIM .EQ. 3) DCEL = DCEL + 627 : & (MPGAL1.VPOCHA(NLCEG, 3) * DZG) 628 : AL1G = VALCEL + (LIMCEL * DCEL) 629 : C write(*,*) valcel, limcel, dcel 630 : C 631 : VALCEL = MPAL2.VPOCHA(NLCEG, 1) 632 : LIMCEL = MPLAL2.VPOCHA(NLCEG, 1) 633 : DCEL = (MPGAL2.VPOCHA(NLCEG, 1) * DXG) + 634 : & (MPGAL2.VPOCHA(NLCEG, 2) * DYG) 635 : IF (IDIM .EQ. 3) DCEL = DCEL + 636 : & (MPGAL2.VPOCHA(NLCEG, 3) * DZG) 637 : AL2G = VALCEL + (LIMCEL * DCEL) 638 : C 639 : C RN 640 : C 641 : VALCEL = MPRN1.VPOCHA(NLCEG, 1) 642 : LIMCEL = MPLRN1.VPOCHA(NLCEG, 1) 643 : DCEL = (MPGRN1.VPOCHA(NLCEG, 1) * DXG) + 644 : & (MPGRN1.VPOCHA(NLCEG, 2) * DYG) 645 : IF (IDIM .EQ. 3) DCEL = DCEL + 646 : & (MPGRN1.VPOCHA(NLCEG, 3) * DZG) 647 : RN1G = VALCEL + (LIMCEL * DCEL) 648 : C 649 : VALCEL = MPRN2.VPOCHA(NLCEG, 1) 650 : LIMCEL = MPLRN2.VPOCHA(NLCEG, 1) 651 : DCEL = (MPGRN2.VPOCHA(NLCEG, 1) * DXG) + 652 : & (MPGRN2.VPOCHA(NLCEG, 2) * DYG) 653 : IF (IDIM .EQ. 3) DCEL = DCEL + 654 : & (MPGRN2.VPOCHA(NLCEG, 3) * DZG) 655 : RN2G = VALCEL + (LIMCEL * DCEL) 656 : C 657 : C PN 658 : C 659 : VALCEL = MPPN1.VPOCHA(NLCEG, 1) 660 : LIMCEL = MPLPN1.VPOCHA(NLCEG, 1) 661 : DCEL = (MPGPN1.VPOCHA(NLCEG, 1) * DXG) + 662 : & (MPGPN1.VPOCHA(NLCEG, 2) * DYG) 663 : IF (IDIM .EQ. 3) DCEL = DCEL + 664 : & (MPGPN1.VPOCHA(NLCEG, 3) * DZG) 665 : PN1G = VALCEL + (LIMCEL * DCEL) 666 : C 667 : VALCEL = MPPN2.VPOCHA(NLCEG, 1) 668 : LIMCEL = MPLPN2.VPOCHA(NLCEG, 1) 669 : DCEL = (MPGPN2.VPOCHA(NLCEG, 1) * DXG) + 670 : & (MPGPN2.VPOCHA(NLCEG, 2) * DYG) 671 : IF (IDIM .EQ. 3) DCEL = DCEL + 672 : & (MPGPN2.VPOCHA(NLCEG, 3) * DZG) 673 : PN2G = VALCEL + (LIMCEL * DCEL) 674 : C 675 : C VN 676 : C 677 : IF (IDIM .EQ. 2) THEN 678 : VALCEL = MPVN1.VPOCHA(NLCEG, 1) 679 : LIMCEL = MPLVN1.VPOCHA(NLCEG, 1) 680 : DCEL = MPGVN1.VPOCHA(NLCEG, 1)*DXG + 681 : & MPGVN1.VPOCHA(NLCEG, 2)*DYG 682 : UX1G = VALCEL + LIMCEL * DCEL 683 : C 684 : VALCEL = MPVN1.VPOCHA(NLCEG, 2) 685 : LIMCEL = MPLVN1.VPOCHA(NLCEG, 2) 686 : DCEL = MPGVN1.VPOCHA(NLCEG, 3)*DXG + 687 : & MPGVN1.VPOCHA(NLCEG, 4)*DYG 688 : UY1G = VALCEL + LIMCEL * DCEL 689 : C 690 : VALCEL = MPVN2.VPOCHA(NLCEG, 1) 691 : LIMCEL = MPLVN2.VPOCHA(NLCEG, 1) 692 : DCEL = MPGVN2.VPOCHA(NLCEG, 1)*DXG + 693 : & MPGVN2.VPOCHA(NLCEG, 2)*DYG 694 : UX2G = VALCEL + LIMCEL * DCEL 695 : C 696 : VALCEL = MPVN2.VPOCHA(NLCEG, 2) 697 : LIMCEL = MPLVN2.VPOCHA(NLCEG, 2) 698 : DCEL = MPGVN2.VPOCHA(NLCEG, 3)*DXG + 699 : & MPGVN2.VPOCHA(NLCEG, 4)*DYG 700 : UY2G = VALCEL + LIMCEL * DCEL 701 : ELSE 702 : VALCEL = MPVN1.VPOCHA(NLCEG, 1) 703 : LIMCEL = MPLVN1.VPOCHA(NLCEG, 1) 704 : DCEL = MPGVN1.VPOCHA(NLCEG, 1)*DXG + 705 : & MPGVN1.VPOCHA(NLCEG, 2)*DYG + 706 : & MPGVN1.VPOCHA(NLCEG, 3)*DZG 707 : UX1G = VALCEL + LIMCEL * DCEL 708 : C 709 : VALCEL = MPVN1.VPOCHA(NLCEG, 2) 710 : LIMCEL = MPLVN1.VPOCHA(NLCEG, 2) 711 : DCEL = MPGVN1.VPOCHA(NLCEG, 4)*DXG + 712 : & MPGVN1.VPOCHA(NLCEG, 5)*DYG + 713 : & MPGVN1.VPOCHA(NLCEG, 6)*DZG 714 : UY1G = VALCEL + LIMCEL * DCEL 715 : C 716 : VALCEL = MPVN1.VPOCHA(NLCEG, 3) 717 : LIMCEL = MPLVN1.VPOCHA(NLCEG, 3) 718 : DCEL = MPGVN1.VPOCHA(NLCEG, 7)*DXG + 719 : & MPGVN1.VPOCHA(NLCEG, 8)*DYG + 720 : & MPGVN1.VPOCHA(NLCEG, 9)*DZG 721 : UZ1G = VALCEL + LIMCEL * DCEL 722 : C 723 : VALCEL = MPVN2.VPOCHA(NLCEG, 1) 724 : LIMCEL = MPLVN2.VPOCHA(NLCEG, 1) 725 : DCEL = MPGVN2.VPOCHA(NLCEG, 1)*DXG + 726 : & MPGVN2.VPOCHA(NLCEG, 2)*DYG + 727 : & MPGVN2.VPOCHA(NLCEG, 3)*DZG 728 : UX2G = VALCEL + LIMCEL * DCEL 729 : C 730 : VALCEL = MPVN2.VPOCHA(NLCEG, 2) 731 : LIMCEL = MPLVN2.VPOCHA(NLCEG, 2) 732 : DCEL = MPGVN2.VPOCHA(NLCEG, 4)*DXG + 733 : & MPGVN2.VPOCHA(NLCEG, 5)*DYG + 734 : & MPGVN2.VPOCHA(NLCEG, 6)*DZG 735 : UY2G = VALCEL + LIMCEL * DCEL 736 : C 737 : VALCEL = MPVN2.VPOCHA(NLCEG, 3) 738 : LIMCEL = MPLVN2.VPOCHA(NLCEG, 3) 739 : DCEL = MPGVN2.VPOCHA(NLCEG, 7)*DXG + 740 : & MPGVN2.VPOCHA(NLCEG, 8)*DYG + 741 : & MPGVN2.VPOCHA(NLCEG, 9)*DZG 742 : UZ2G = VALCEL + LIMCEL * DCEL 743 : ENDIF 744 : 745 : C 746 : C******* Si l'on fait pas de prediction, ce n'est pas necessaire de 747 : C controller la positivite' de la pression et de la densité; elle 748 : C est déjà garantie par la proprieté LED de limiteur; mais, vu 749 : C que le limiteur n'est pas calculé ici, mais dans un autre 750 : C operateur, on le fait 751 : C 752 : LOGI1 = (RN1G .LT. 0.0D0) .OR. (RN2G .LT. 0.0D0) .OR. 753 : & (PN1G .LT. 0.0D0) .OR. (PN2G .LT. 0.0D0) .OR. 754 : & (AL1G .LT. 0.0D0) .OR. (AL2G .LT. 0.0D0) .OR. 755 : & (AL1G .GT. 1.0D0) .OR. (AL2G .GT. 1.0D0) 756 : C 757 : IF ( NGCEG .EQ. NGCED) THEN 758 : C 759 : C********** Cas mur 760 : C 761 : IF(LOGI1)THEN 762 : C 763 : C********** Premier ordre en espace local 764 : C 765 : AL1G = MPAL1.VPOCHA(NLCEG,1) 766 : AL2G = MPAL2.VPOCHA(NLCEG,1) 767 : RN1G = MPRN1.VPOCHA(NLCEG,1) 768 : RN2G = MPRN2.VPOCHA(NLCEG,1) 769 : PN1G = MPPN1.VPOCHA(NLCEG,1) 770 : PN2G = MPPN2.VPOCHA(NLCEG,1) 771 : UX1G = MPVN1.VPOCHA(NLCEG,1) 772 : UY1G = MPVN1.VPOCHA(NLCEG,2) 773 : UX2G = MPVN2.VPOCHA(NLCEG,1) 774 : UY2G = MPVN2.VPOCHA(NLCEG,2) 775 : IF (IDIM .EQ. 3) THEN 776 : UZ1G = MPVN1.VPOCHA(NLCEG,3) 777 : UZ2G = MPVN2.VPOCHA(NLCEG,3) 778 : ENDIF 779 : ENDIF 780 : C 781 : UN1G = UX1G * CNX + UY1G * CNY + UZ1G * CNZ 782 : UT1G = UX1G * CTX + UY1G * CTY + UZ1G * CTZ 783 : UN2G = UX2G * CNX + UY2G * CNY + UZ2G * CNZ 784 : UT2G = UX2G * CTX + UY2G * CTY + UZ2G * CTZ 785 : UV1G = UX1G * CVX + UY1G * CVY + UZ1G * CVZ 786 : UV2G = UX2G * CVX + UY2G * CVY + UZ2G * CVZ 787 : C 788 : C********** Son etat droite 789 : C 790 : AL1D = AL1G 791 : AL2D = AL2G 792 : RN1D = RN1G 793 : RN2D = RN2G 794 : PN1D = PN1G 795 : PN2D = PN2G 796 : UN1D = -1.0D0 * UN1G 797 : UN2D = -1.0D0 * UN2G 798 : UT1D = UT1G 799 : UT2D = UT2G 800 : UV1D = UV1G 801 : UV2D = UV2G 802 : C 803 : C********** Fin cas mur 804 : C 805 : ELSE 806 : VALCEL = MPAL1.VPOCHA(NLCED, 1) 807 : LIMCEL = MPLAL1.VPOCHA(NLCED, 1) 808 : DCEL = (MPGAL1.VPOCHA(NLCED, 1) * DXD) + 809 : & (MPGAL1.VPOCHA(NLCED, 2) * DYD) 810 : IF (IDIM .EQ. 3) DCEL = DCEL + 811 : & (MPGAL1.VPOCHA(NLCED, 3) * DZD) 812 : AL1D = VALCEL + (LIMCEL * DCEL) 813 : C 814 : VALCEL = MPAL2.VPOCHA(NLCED, 1) 815 : LIMCEL = MPLAL2.VPOCHA(NLCED, 1) 816 : DCEL = (MPGAL2.VPOCHA(NLCED, 1) * DXD) + 817 : & (MPGAL2.VPOCHA(NLCED, 2) * DYD) 818 : IF (IDIM .EQ. 3) DCEL = DCEL + 819 : & (MPGAL2.VPOCHA(NLCED, 3) * DZD) 820 : AL2D = VALCEL + (LIMCEL * DCEL) 821 : C 822 : C RN 823 : C 824 : VALCEL = MPRN1.VPOCHA(NLCED, 1) 825 : LIMCEL = MPLRN1.VPOCHA(NLCED, 1) 826 : DCEL = (MPGRN1.VPOCHA(NLCED, 1) * DXD) + 827 : & (MPGRN1.VPOCHA(NLCED, 2) * DYD) 828 : IF (IDIM .EQ. 3) DCEL = DCEL + 829 : & (MPGRN1.VPOCHA(NLCED, 3) * DZD) 830 : RN1D = VALCEL + (LIMCEL * DCEL) 831 : C 832 : VALCEL = MPRN2.VPOCHA(NLCED, 1) 833 : LIMCEL = MPLRN2.VPOCHA(NLCED, 1) 834 : DCEL = (MPGRN2.VPOCHA(NLCED, 1) * DXD) + 835 : & (MPGRN2.VPOCHA(NLCED, 2) * DYD) 836 : IF (IDIM .EQ. 3) DCEL = DCEL + 837 : & (MPGRN2.VPOCHA(NLCED, 3) * DZD) 838 : RN2D = VALCEL + (LIMCEL * DCEL) 839 : C 840 : C PN 841 : C 842 : VALCEL = MPPN1.VPOCHA(NLCED, 1) 843 : LIMCEL = MPLPN1.VPOCHA(NLCED, 1) 844 : DCEL = (MPGPN1.VPOCHA(NLCED, 1) * DXD) + 845 : & (MPGPN1.VPOCHA(NLCED, 2) * DYD) 846 : IF (IDIM .EQ. 3) DCEL = DCEL + 847 : & (MPGPN1.VPOCHA(NLCED, 3) * DZD) 848 : PN1D = VALCEL + (LIMCEL * DCEL) 849 : C 850 : VALCEL = MPPN2.VPOCHA(NLCED, 1) 851 : LIMCEL = MPLPN2.VPOCHA(NLCED, 1) 852 : DCEL = (MPGPN2.VPOCHA(NLCED, 1) * DXD) + 853 : & (MPGPN2.VPOCHA(NLCED, 2) * DYD) 854 : IF (IDIM .EQ. 3) DCEL = DCEL + 855 : & (MPGPN2.VPOCHA(NLCED, 3) * DZD) 856 : PN2D = VALCEL + (LIMCEL * DCEL) 857 : C 858 : C VN 859 : C 860 : IF (IDIM .EQ. 2) THEN 861 : VALCEL = MPVN1.VPOCHA(NLCED, 1) 862 : LIMCEL = MPLVN1.VPOCHA(NLCED, 1) 863 : DCEL = MPGVN1.VPOCHA(NLCED, 1)*DXD + 864 : & MPGVN1.VPOCHA(NLCED, 2)*DYD 865 : UX1D = VALCEL + LIMCEL * DCEL 866 : C 867 : VALCEL = MPVN1.VPOCHA(NLCED, 2) 868 : LIMCEL = MPLVN1.VPOCHA(NLCED, 2) 869 : DCEL = MPGVN1.VPOCHA(NLCED, 3)*DXD + 870 : & MPGVN1.VPOCHA(NLCED, 4)*DYD 871 : UY1D = VALCEL + LIMCEL * DCEL 872 : C 873 : VALCEL = MPVN2.VPOCHA(NLCED, 1) 874 : LIMCEL = MPLVN2.VPOCHA(NLCED, 1) 875 : DCEL = MPGVN2.VPOCHA(NLCED, 1)*DXD + 876 : & MPGVN2.VPOCHA(NLCED, 2)*DYD 877 : UX2D = VALCEL + LIMCEL * DCEL 878 : C 879 : VALCEL = MPVN2.VPOCHA(NLCED, 2) 880 : LIMCEL = MPLVN2.VPOCHA(NLCED, 2) 881 : DCEL = MPGVN2.VPOCHA(NLCED, 3)*DXD + 882 : & MPGVN2.VPOCHA(NLCED, 4)*DYD 883 : UY2D = VALCEL + LIMCEL * DCEL 884 : ELSE 885 : VALCEL = MPVN1.VPOCHA(NLCED, 1) 886 : LIMCEL = MPLVN1.VPOCHA(NLCED, 1) 887 : DCEL = MPGVN1.VPOCHA(NLCED, 1)*DXD + 888 : & MPGVN1.VPOCHA(NLCED, 2)*DYD + 889 : & MPGVN1.VPOCHA(NLCED, 3)*DZD 890 : UX1D = VALCEL + LIMCEL * DCEL 891 : C 892 : VALCEL = MPVN1.VPOCHA(NLCED, 2) 893 : LIMCEL = MPLVN1.VPOCHA(NLCED, 2) 894 : DCEL = MPGVN1.VPOCHA(NLCED, 4)*DXD + 895 : & MPGVN1.VPOCHA(NLCED, 5)*DYD + 896 : & MPGVN1.VPOCHA(NLCED, 6)*DZD 897 : UY1D = VALCEL + LIMCEL * DCEL 898 : C 899 : VALCEL = MPVN1.VPOCHA(NLCED, 3) 900 : LIMCEL = MPLVN1.VPOCHA(NLCED, 3) 901 : DCEL = MPGVN1.VPOCHA(NLCED, 7)*DXD + 902 : & MPGVN1.VPOCHA(NLCED, 8)*DYD + 903 : & MPGVN1.VPOCHA(NLCED, 9)*DZD 904 : UZ1D = VALCEL + LIMCEL * DCEL 905 : C 906 : VALCEL = MPVN2.VPOCHA(NLCED, 1) 907 : LIMCEL = MPLVN2.VPOCHA(NLCED, 1) 908 : DCEL = MPGVN2.VPOCHA(NLCED, 1)*DXD + 909 : & MPGVN2.VPOCHA(NLCED, 2)*DYD + 910 : & MPGVN2.VPOCHA(NLCED, 3)*DZD 911 : UX2D = VALCEL + LIMCEL * DCEL 912 : C 913 : VALCEL = MPVN2.VPOCHA(NLCED, 2) 914 : LIMCEL = MPLVN2.VPOCHA(NLCED, 2) 915 : DCEL = MPGVN2.VPOCHA(NLCED, 4)*DXD + 916 : & MPGVN2.VPOCHA(NLCED, 5)*DYD + 917 : & MPGVN2.VPOCHA(NLCED, 6)*DZD 918 : UY2D = VALCEL + LIMCEL * DCEL 919 : C 920 : VALCEL = MPVN2.VPOCHA(NLCED, 3) 921 : LIMCEL = MPLVN2.VPOCHA(NLCED, 3) 922 : DCEL = MPGVN2.VPOCHA(NLCED, 7)*DXD + 923 : & MPGVN2.VPOCHA(NLCED, 8)*DYD + 924 : & MPGVN2.VPOCHA(NLCED, 9)*DZD 925 : UZ2D = VALCEL + LIMCEL * DCEL 926 : C 927 : ENDIF 928 : C 929 : C********** Si l'on fait pas de prediction, ce n'est pas necessaire de 930 : C controller la positivite' de la pression et de la densité; elle 931 : C est déjà garantie par la proprieté LED de limiteur; mais, vu 932 : C que le limiteur n'est pas calculé ici, mais dans un autre 933 : C operateur, on le fait 934 : C 935 : LOGI1 = LOGI1 .OR. (RN1D .LT. 0.0D0) .OR. (RN2D .LT. 0.0D0) 936 : $ .OR.(PN1D .LT. 0.0D0) .OR. (PN2D .LT. 0.0D0) .OR. 937 : $ (AL1D .LT. 0.0D0) .OR. (AL2D .LT. 0.0D0) .OR. 938 : $ (AL1D .GT. 1.0D0) .OR. (AL2D .GT. 1.0D0) 939 : C 940 : IF(LOGI1)THEN 941 : C 942 : C************* Premier ordre en espace local 943 : C 944 : AL1G = MPAL1.VPOCHA(NLCEG,1) 945 : AL2G = MPAL2.VPOCHA(NLCEG,1) 946 : RN1G = MPRN1.VPOCHA(NLCEG,1) 947 : RN2G = MPRN2.VPOCHA(NLCEG,1) 948 : PN1G = MPPN1.VPOCHA(NLCEG,1) 949 : PN2G = MPPN2.VPOCHA(NLCEG,1) 950 : UX1G = MPVN1.VPOCHA(NLCEG,1) 951 : UY1G = MPVN1.VPOCHA(NLCEG,2) 952 : UX2G = MPVN2.VPOCHA(NLCEG,1) 953 : UY2G = MPVN2.VPOCHA(NLCEG,2) 954 : C 955 : AL1D = MPAL1.VPOCHA(NLCED,1) 956 : AL2D = MPAL2.VPOCHA(NLCED,1) 957 : RN1D = MPRN1.VPOCHA(NLCED,1) 958 : RN2D = MPRN2.VPOCHA(NLCED,1) 959 : PN1D = MPPN1.VPOCHA(NLCED,1) 960 : PN2D = MPPN2.VPOCHA(NLCED,1) 961 : UX1D = MPVN1.VPOCHA(NLCED,1) 962 : UY1D = MPVN1.VPOCHA(NLCED,2) 963 : UX2D = MPVN2.VPOCHA(NLCED,1) 964 : UY2D = MPVN2.VPOCHA(NLCED,2) 965 : C 966 : IF (IDIM .EQ. 3) THEN 967 : UZ1G = MPVN1.VPOCHA(NLCEG,3) 968 : UZ2G = MPVN2.VPOCHA(NLCEG,3) 969 : UZ1D = MPVN1.VPOCHA(NLCED,3) 970 : UZ2D = MPVN2.VPOCHA(NLCED,3) 971 : ENDIF 972 : 973 : ENDIF 974 : C 975 : UN1G = UX1G * CNX + UY1G * CNY + UZ1G * CNZ 976 : UT1G = UX1G * CTX + UY1G * CTY + UZ1G * CTZ 977 : UV1G = UX1G * CVX + UY1G * CVY + UZ1G * CVZ 978 : UN2G = UX2G * CNX + UY2G * CNY + UZ2G * CNZ 979 : UT2G = UX2G * CTX + UY2G * CTY + UZ2G * CTZ 980 : UV2G = UX2G * CVX + UY2G * CVY + UZ2G * CVZ 981 : C 982 : UN1D = UX1D * CNX + UY1D * CNY + UZ1D * CNZ 983 : UT1D = UX1D * CTX + UY1D * CTY + UZ1D * CTZ 984 : UV1D = UX1D * CVX + UY1D * CVY + UZ1D * CVZ 985 : UN2D = UX2D * CNX + UY2D * CNY + UZ2D * CNZ 986 : UT2D = UX2D * CTX + UY2D * CTY + UZ2D * CTZ 987 : UV2D = UX2D * CVX + UY2D * CVY + UZ2D * CVZ 988 : C 989 : ENDIF 990 : C 991 : C 992 : C******** Les MELVALs 993 : C 994 : MELAL1.VELCHE(1,NLCF) = AL1G 995 : MELAL1.VELCHE(3,NLCF) = AL1D 996 : MELAL2.VELCHE(1,NLCF) = AL2G 997 : MELAL2.VELCHE(3,NLCF) = AL2D 998 : C 999 : MELRN1.VELCHE(1,NLCF) = RN1G 1000 : MELRN1.VELCHE(3,NLCF) = RN1D 1001 : MELRN2.VELCHE(1,NLCF) = RN2G 1002 : MELRN2.VELCHE(3,NLCF) = RN2D 1003 : C 1004 : MELPN1.VELCHE(1,NLCF) = PN1G 1005 : MELPN1.VELCHE(3,NLCF) = PN1D 1006 : MELPN2.VELCHE(1,NLCF) = PN2G 1007 : MELPN2.VELCHE(3,NLCF) = PN2D 1008 : C 1009 : MEVUN1.VELCHE(1,NLCF) = UN1G 1010 : MEVUN1.VELCHE(3,NLCF) = UN1D 1011 : MEVUT1.VELCHE(1,NLCF) = UT1G 1012 : MEVUT1.VELCHE(3,NLCF) = UT1D 1013 : MEVUN2.VELCHE(1,NLCF) = UN2G 1014 : MEVUN2.VELCHE(3,NLCF) = UN2D 1015 : MEVUT2.VELCHE(1,NLCF) = UT2G 1016 : MEVUT2.VELCHE(3,NLCF) = UT2D 1017 : MELVNX.VELCHE(1,NLCF) = CNX 1018 : MELVNY.VELCHE(1,NLCF) = CNY 1019 : MELT1X.VELCHE(1,NLCF) = CTX 1020 : MELT1Y.VELCHE(1,NLCF) = CTY 1021 : IF (IDIM .EQ. 3) THEN 1022 : MELVNZ.VELCHE(1,NLCF) = CNZ 1023 : MELT1Z.VELCHE(1,NLCF) = CTZ 1024 : MELT2X.VELCHE(1,NLCF) = CVX 1025 : MELT2Y.VELCHE(1,NLCF) = CVY 1026 : MELT2Z.VELCHE(1,NLCF) = CVZ 1027 : C 1028 : MEVUV1.VELCHE(1,NLCF) = UV1G 1029 : MEVUV1.VELCHE(3,NLCF) = UV1D 1030 : MEVUV2.VELCHE(1,NLCF) = UV2G 1031 : MEVUV2.VELCHE(3,NLCF) = UV2D 1032 : ENDIF 1033 : ENDDO 1034 : C 1035 : C**** Desactivation des SEGMENTs 1036 : C 1037 : SEGDES IPT1 1038 : SEGDES IPT2 1039 : C 1040 : C MPOVALs 1041 : C 1042 : SEGDES MPNORM 1043 : C 1044 : SEGDES MPAL1 1045 : SEGDES MPGAL1 1046 : SEGDES MPLAL1 1047 : SEGDES MPAL2 1048 : SEGDES MPGAL2 1049 : SEGDES MPLAL2 1050 : C 1051 : SEGDES MPRN1 1052 : SEGDES MPGRN1 1053 : SEGDES MPLRN1 1054 : SEGDES MPRN2 1055 : SEGDES MPGRN2 1056 : SEGDES MPLRN2 1057 : C 1058 : SEGDES MPPN1 1059 : SEGDES MPGPN1 1060 : SEGDES MPLPN1 1061 : SEGDES MPPN2 1062 : SEGDES MPGPN2 1063 : SEGDES MPLPN2 1064 : C 1065 : SEGDES MPVN1 1066 : SEGDES MPGVN1 1067 : SEGDES MPLVN1 1068 : SEGDES MPVN2 1069 : SEGDES MPGVN2 1070 : SEGDES MPLVN2 1071 : C 1072 : C MELVALs 1073 : C 1074 : SEGDES MELVNX 1075 : SEGDES MELVNY 1076 : SEGDES MELT1X 1077 : SEGDES MELT1Y 1078 : SEGDES MEVUN1 1079 : SEGDES MEVUT1 1080 : SEGDES MEVUN2 1081 : SEGDES MEVUT2 1082 : IF (IDIM .EQ. 3) THEN 1083 : SEGDES MELVNZ 1084 : SEGDES MELT1Z 1085 : SEGDES MELT2X 1086 : SEGDES MELT2Y 1087 : SEGDES MELT2Z 1088 : SEGDES MEVUV1 1089 : SEGDES MEVUV2 1090 : ENDIF 1091 : C 1092 : SEGDES MELAL1 1093 : SEGDES MELAL2 1094 : C 1095 : SEGDES MELRN1 1096 : SEGDES MELRN2 1097 : C 1098 : SEGDES MELPN1 1099 : SEGDES MELPN2 1100 : C 1101 : C 1102 : C**** Destruction du MELNTI correspondance local/global 1103 : C 1104 : SEGSUP MLENT1 1105 : C 1106 : 9999 CONTINUE 1107 : C 1108 : RETURN 1109 : END 1110 : 1111 : 1112 : 1113 : 1114 : 1115 : 1116 : 1117 : 1118 : 1119 : 1120 : 1121 : 1122 :
© Cast3M 2003 - All rights reserved.
Disclaimer