1 : C KONJP5 SOURCE MAGN 09/07/30 21:18:20 6458 2 : SUBROUTINE KONJP5(ILINC,ILINP,IRN,IUN,IPN,IGAMN,INORM,ICHPVO 3 : $ ,ICHPSU,IUINF,IUPRI,MELEMC,MELEFE,MELLIM,IMAT) 4 : C 5 : C************************************************************************ 6 : C 7 : C PROJET : CASTEM 2000 8 : C 9 : C NOM : KONJP5 10 : C 11 : C DESCRIPTION : Voir KON14 12 : C Calcul du jacobien du résidu pour la méthode 13 : C AUSMplus Low Mach 14 : C 14 : C Cas deux dimensions, gaz "calorically perfect" 15 : C 16 : C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI) 17 : C 18 : C AUTEUR : A.BECCANTINI, S. KUDRIAKOV, DM2S/SFME/LTMF 19 : C 20 : C************************************************************************ 21 : C 22 : C 23 : C APPELES (Outils 24 : C CASTEM) : KRIPAD, LICHT, ERREUR 25 : C 26 : C APPELES (Calcul) : 27 : C 28 : C************************************************************************ 29 : C 30 : C ENTREES 31 : C 32 : C ILINC : liste des variables cons. (pointeur d'un objet de type LISTMOTS) 33 : C 34 : C ILINP : liste des variables prim. (pointeur d'un objet de type LISTMOTS) 35 : C 36 : C 1) Pointeurs des CHPOINT 37 : C 38 : C IRN : CHPOINT CENTRE contenant la masse volumique ; 39 : C 40 : C IUN : CHPOINT CENTRE contenant la vitesse ; 41 : C 42 : C IPN : CHPOINT CENTRE contenant la pression ; 43 : C 44 : C IGAMN : CHPOINT CENTRE contenant le gamma ; 45 : C 46 : C INORM : CHPOINT FACE contenant les normales aux faces ; 47 : C 48 : C ICHPVO : CHPOINT VOLUME contenant le volume 49 : C 50 : C ICHPSU : CHPOINT FACE contenant la surface des faces 51 : C 52 : C 2) Pointeurs de MELEME de la table DOMAINE 53 : C 54 : C MELEMC : MELEME 'CENTRE' du SPG des CENTRES 55 : C 56 : C MELEFE : MELEME 'FACEL' du connectivité Faces -> Elts 57 : C 58 : C MELLIM : MELEME SPG des conditions aux bords 59 : C 60 : C 3) Cas Bas MACH 61 : C 62 : C IUINF : CHPOINT, one component, "cut-off velocity" 63 : C 0 if there is no Bas MACH 64 : C 65 : C IUPRI : CHPOINT, one component, second "cut-off velocity" 66 : C 0 if there is no Bas MACH 67 : C 68 : C SORTIES 69 : C 70 : C IMAT : pointeur de la MATRIK du jacobien du residu 71 : C 72 : C************************************************************************ 73 : C 74 : C HISTORIQUE (Anomalies et modifications éventuelles) 75 : C 76 : C HISTORIQUE : 77 : C 78 : C************************************************************************ 79 : C 80 : C 81 : C N.B.: On suppose qu'on a déjà controllé RO, P > 0 82 : C GAMMA \in (1,3) 83 : C Si non il faut le faire!!! 84 : C 85 : C************************************************************************ 86 : C 87 : C 88 : C**** Variables de COOPTIO 89 : C 90 : C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR 91 : C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ 92 : C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES 93 : C & ,IECHO, IIMPI, IOSPI 94 : C & ,IDIM 95 : C & ,MCOORD 96 : C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE 97 : C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU 98 : C & ,NORINC,NORVAL,NORIND,NORVAD 99 : C & ,NUCROU, IPSAUV, IFICLE, IPREFI 100 : C 101 : IMPLICIT INTEGER(I-N) 102 : INTEGER ILINC, ILINP, IRN,IUN,IPN,IGAMN,INORM,ICHPVO,ICHPSU 103 : & , IMAT, IGEOMC, IGEOMF, IUINF, IUPRI 104 : & , NFAC, NBSOUS, NBREF, NBELEM, NBNN, NRIGE, NMATRI, NKID 105 : & , NKMT, NBME, NBEL, MP, NP 106 : & , IFAC, NGCF, NLCF, NGCG, NGCD, NLCG, NLCD, NLFL 107 : REAL*8 ROG, PG, UXG, UYG, GAMG, VOLG 108 : & , ROD, PD, UXD, UYD, VOLD, UPR_L, UPR_R 109 : & , SURF, FUNCEL, V_INF, UPR_M 110 : REAL*8 WVEC_L(4), WVEC_R(4), NVECT(2), TVECT(2) 111 : REAL*8 JTL(4,4), JTR(4,4) 112 : REAL*8 ZC1, ZC2, ZC3, ZC4 113 : CHARACTER*8 TYPE 114 : C 115 : C**** LES INCLUDES 116 : C 117 : -INC CCOPTIO 118 : -INC SMCHPOI 119 : -INC SMMATRIK 120 : -INC SMELEME 121 : -INC SMLMOTS 122 : -INC SMLENTI 123 : POINTEUR MPRN.MPOVAL, MPUN.MPOVAL, MPPN.MPOVAL, MPGAMN.MPOVAL, 124 : & MPNORM.MPOVAL, MPVOLU.MPOVAL, MPOVSU.MPOVAL, 125 : & MPOVDI.MPOVAL 126 : POINTEUR MELEMC.MELEME, MELEMF.MELEME, MELEFE.MELEME, 127 : & MELEDU.MELEME, MELLIM.MELEME 128 : POINTEUR MLENTC.MLENTI, MLENTF.MLENTI, MLELIM.MLENTI 129 : POINTEUR RR.IZAFM, RUX.IZAFM, RUY.IZAFM, RRET.IZAFM, 130 : & UXR.IZAFM, UXUX.IZAFM, UXUY.IZAFM, UXRET.IZAFM, 131 : & UYR.IZAFM, UYUX.IZAFM, UYUY.IZAFM, UYRET.IZAFM, 132 : & RETR.IZAFM, RETUX.IZAFM, RETUY.IZAFM, RETRET.IZAFM 133 : POINTEUR MLMINC.MLMOTS, MPUPRI.MPOVAL, MPUINF.MPOVAL 134 : C 135 : C**** KRIPAD pour la correspondance global/local des conditions limits 136 : C 136 : CALL KRIPAD(MELLIM,MLELIM) 137 : C SEGACT MELLIM 138 : C 139 : C**** KRIPAD pour la correspondance global/local des centres 140 : C 140 : CALL KRIPAD(MELEMC,MLENTC) 141 : C 142 : C SEGACT MLENTC 143 : SEGACT MELEMC 144 : C 145 : SEGACT MELEFE 146 : C 146 : CALL LICHT(ICHPSU,MPOVSU,TYPE,IGEOMF) 146 : CALL LICHT(INORM,MPNORM,TYPE,IGEOMF) 146 : CALL LICHT(ICHPVO,MPVOLU,TYPE,IGEOMC) 147 : C 148 : C**** LICHT active les MPOVALs en *MOD 149 : C 150 : C i.e. 151 : C 152 : C SEGACT MPOVSU*MOD 153 : C SEGACT MPOVNO*MOD 154 : C SEGACT MPVOLU*MOD 155 : C 156 : MELEMF = IGEOMF 156 : CALL KRIPAD(MELEMF,MLENTF) 157 : C 158 : C SEGACT MLENTF 159 : SEGACT MELEMF 160 : C 160 : CALL LICHT(IRN,MPRN,TYPE,IGEOMC) 160 : CALL LICHT(IPN,MPPN,TYPE,IGEOMC) 160 : CALL LICHT(IUN,MPUN,TYPE,IGEOMC) 160 : CALL LICHT(IGAMN,MPGAMN,TYPE,IGEOMC) 161 : C 162 : C SEGACT MPRN*MOD 163 : C SEGACT MPPN*MOD 164 : C SEGACT MPUN*MOD 165 : C SEGACT MPGAMN*MOD 166 : C 167 : NFAC = MELEFE.NUM(/2) 168 : C 169 : C**** Maillage des inconnues primales 170 : C 171 : NBSOUS = 0 172 : NBREF = 0 173 : NBELEM = NFAC 174 : NBNN = 2 175 : C 176 : SEGINI MELEDU 177 : C MELEPR = MELEDU 178 : C 179 : C**** MELEDU = 'SEG2' 180 : C 181 : MELEDU.ITYPEL = 2 182 : C 183 : NRIGE = 7 184 : NMATRI = 1 185 : NKID = 9 186 : NKMT = 7 187 : C 188 : SEGINI MATRIK 189 : IMAT = MATRIK 190 : MATRIK.IRIGEL(1,1) = MELEDU 191 : MATRIK.IRIGEL(2,1) = MELEDU 192 : C 193 : C**** Matrice non symetrique 194 : C 195 : MATRIK.IRIGEL(7,1) = 2 196 : C 197 : NBME = 16 198 : NBSOUS = 1 199 : SEGINI IMATRI 200 : MATRIK.IRIGEL(4,1) = IMATRI 201 : C 202 : MLMINC = ILINP 203 : SEGACT MLMINC 204 : IMATRI.LISPRI(1) = MLMINC.MOTS(1) 205 : IMATRI.LISPRI(2) = MLMINC.MOTS(2) 206 : IMATRI.LISPRI(3) = MLMINC.MOTS(3) 207 : IMATRI.LISPRI(4) = MLMINC.MOTS(4) 208 : IMATRI.LISPRI(5) = MLMINC.MOTS(1) 209 : IMATRI.LISPRI(6) = MLMINC.MOTS(2) 210 : IMATRI.LISPRI(7) = MLMINC.MOTS(3) 211 : IMATRI.LISPRI(8) = MLMINC.MOTS(4) 212 : IMATRI.LISPRI(9) = MLMINC.MOTS(1) 213 : IMATRI.LISPRI(10) = MLMINC.MOTS(2) 214 : IMATRI.LISPRI(11) = MLMINC.MOTS(3) 215 : IMATRI.LISPRI(12) = MLMINC.MOTS(4) 216 : IMATRI.LISPRI(13) = MLMINC.MOTS(1) 217 : IMATRI.LISPRI(14) = MLMINC.MOTS(2) 218 : IMATRI.LISPRI(15) = MLMINC.MOTS(3) 219 : IMATRI.LISPRI(16) = MLMINC.MOTS(4) 220 : SEGDES MLMINC 221 : C 222 : MLMINC = ILINC 223 : SEGACT MLMINC 224 : IMATRI.LISDUA(1) = MLMINC.MOTS(1) 225 : IMATRI.LISDUA(2) = MLMINC.MOTS(1) 226 : IMATRI.LISDUA(3) = MLMINC.MOTS(1) 227 : IMATRI.LISDUA(4) = MLMINC.MOTS(1) 228 : IMATRI.LISDUA(5) = MLMINC.MOTS(2) 229 : IMATRI.LISDUA(6) = MLMINC.MOTS(2) 230 : IMATRI.LISDUA(7) = MLMINC.MOTS(2) 231 : IMATRI.LISDUA(8) = MLMINC.MOTS(2) 232 : IMATRI.LISDUA(9) = MLMINC.MOTS(3) 233 : IMATRI.LISDUA(10) = MLMINC.MOTS(3) 234 : IMATRI.LISDUA(11) = MLMINC.MOTS(3) 235 : IMATRI.LISDUA(12) = MLMINC.MOTS(3) 236 : IMATRI.LISDUA(13) = MLMINC.MOTS(4) 237 : IMATRI.LISDUA(14) = MLMINC.MOTS(4) 238 : IMATRI.LISDUA(15) = MLMINC.MOTS(4) 239 : IMATRI.LISDUA(16) = MLMINC.MOTS(4) 240 : SEGDES MLMINC 241 : C 242 : NBEL = NBELEM 243 : NBSOUS = 1 244 : NP = 2 245 : MP = 2 246 : SEGINI RR , RUX , RUY , RRET , 247 : & UXR , UXUX , UXUY , UXRET , 248 : & UYR , UYUX , UYUY , UYRET , 249 : & RETR , RETUX , RETUY , RETRET 250 : C 251 : C**** Duale = IMATRI.LISDUA(1) = 'RN' 252 : C Primale = IMATRI.LISPRI(1) = 'RN' 253 : C -> IMATRI.LIZAFM(1,1) = RR 254 : C 255 : C Duale = IMATRI.LISDUA(2) = 'RN' 256 : C Primale = IMATRI.LISPRI(1) = 'RUXN' 257 : C -> IMATRI.LIZAFM(1,2) = RUX 258 : C ... 259 : C 260 : IMATRI.LIZAFM(1,1) = RR 261 : IMATRI.LIZAFM(1,2) = RUX 262 : IMATRI.LIZAFM(1,3) = RUY 263 : IMATRI.LIZAFM(1,4) = RRET 264 : IMATRI.LIZAFM(1,5) = UXR 265 : IMATRI.LIZAFM(1,6) = UXUX 266 : IMATRI.LIZAFM(1,7) = UXUY 267 : IMATRI.LIZAFM(1,8) = UXRET 268 : IMATRI.LIZAFM(1,9) = UYR 269 : IMATRI.LIZAFM(1,10) = UYUX 270 : IMATRI.LIZAFM(1,11) = UYUY 271 : IMATRI.LIZAFM(1,12) = UYRET 272 : IMATRI.LIZAFM(1,13) = RETR 273 : IMATRI.LIZAFM(1,14) = RETUX 274 : IMATRI.LIZAFM(1,15) = RETUY 275 : IMATRI.LIZAFM(1,16) = RETRET 276 : C************************************************************** 277 : C Bas Mach 278 : C************************************************************** 278 : CALL LICHT(IUPRI,MPUPRI,TYPE,IGEOMC) 278 : CALL LICHT(IUINF,MPUINF,TYPE,IGEOMC) 279 : C************************************************************** 280 : DO IFAC = 1, NFAC, 1 281 : NGCF = MELEFE.NUM(2,IFAC) 282 : NLCF = MLENTF.LECT(NGCF) 283 : IF(NLCF .NE. IFAC)THEN 284 : WRITE(IOIMP,*) 'Il ne faut pas jouer avec la table domaine' 284 : CALL ERREUR(5) 285 : GOTO 9999 286 : ENDIF 287 : NLFL = MLELIM.LECT(NGCF) 288 : NGCG = MELEFE.NUM(1,IFAC) 289 : NGCD = MELEFE.NUM(3,IFAC) 290 : IF(NLFL .NE. 0)THEN 291 : C 292 : C********** The point belongs on BC -> No contribution to jacobian! 293 : C 294 : MELEDU.NUM(1,IFAC) = NGCG 295 : MELEDU.NUM(2,IFAC) = NGCD 296 : ELSEIF(NGCG .NE. NGCD)THEN 297 : C 298 : C********** Les MELEMEs 299 : C 300 : MELEDU.NUM(1,IFAC) = NGCG 301 : MELEDU.NUM(2,IFAC) = NGCD 302 : C 303 : C********** Les etats G et D 304 : C 305 : NLCG = MLENTC.LECT(NGCG) 306 : NLCD = MLENTC.LECT(NGCD) 307 : C************************************************* 308 : C************************************************* 309 : ROG = MPRN.VPOCHA(NLCG,1) 310 : PG = MPPN.VPOCHA(NLCG,1) 311 : UXG = MPUN.VPOCHA(NLCG,1) 312 : UYG = MPUN.VPOCHA(NLCG,2) 313 : GAMG = MPGAMN.VPOCHA(NLCG,1) 314 : VOLG = MPVOLU.VPOCHA(NLCG,1) 315 : C------------------------------------------------- 316 : WVEC_L(1)=ROG 317 : WVEC_L(2)=UXG 318 : WVEC_L(3)=UYG 319 : WVEC_L(4)=PG 320 : C------------------------------------------------- 321 : ROD = MPRN.VPOCHA(NLCD,1) 322 : PD = MPPN.VPOCHA(NLCD,1) 323 : UXD = MPUN.VPOCHA(NLCD,1) 324 : UYD = MPUN.VPOCHA(NLCD,2) 325 : VOLD = MPVOLU.VPOCHA(NLCD,1) 326 : C------------------------------------------------ 327 : WVEC_R(1)=ROD 328 : WVEC_R(2)=UXD 329 : WVEC_R(3)=UYD 330 : WVEC_R(4)=PD 331 : c------------------------------------------------ 332 : UPR_L=MPUPRI.VPOCHA(NLCG,1) 333 : UPR_R=MPUPRI.VPOCHA(NLCD,1) 334 : UPR_M=MAX(UPR_L,UPR_R) 335 : V_INF=MAX(MPUINF.VPOCHA(NLCG,1),MPUINF.VPOCHA(NLCD,1)) 336 : V_INF=MAX(UPR_M,V_INF) 337 : C------------------------------------------------ 338 : C 339 : C********** La normale G->D 340 : C La tangente 341 : C 342 : SURF = MPOVSU.VPOCHA(NLCF,1) 343 : NVECT(1) = MPNORM.VPOCHA(NLCF,1) 344 : NVECT(2) = MPNORM.VPOCHA(NLCF,2) 345 : TVECT(1) = -1.0D0 * NVECT(2) 346 : TVECT(2) = NVECT(1) 347 : C 347 : CALL CONJP6(JTL,JTR,WVEC_L,WVEC_R, 348 : & NVECT,TVECT,GAMG,V_INF) 349 : C 350 : C 351 : C********** AB.AM(IFAC,IPRIM,IDUAL) 352 : C A = nom de l'inconnu duale (Ro,rUX,rUY,RET) 353 : C B = nom de l'inconnu primale (Ro,rUX,rUY,RET) 354 : C IPRIM = 1, 2 -> G, D 355 : C IDUAL = 1, 2 -> G, D 356 : C i.e. 357 : C A_IDUAL = AB.AM(IFAC,IPRIM,IDUAL) * B_IPRIM + ... 358 : C 359 : C 360 : C********** Dual RN 361 : C 362 : FUNCEL = SURF * JTL(1,1) 363 : RR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 364 : RR.AM(IFAC,1,2) = FUNCEL / VOLD 365 : C 366 : FUNCEL = SURF * JTL(1,2) 367 : RUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 368 : RUX.AM(IFAC,1,2) = FUNCEL / VOLD 369 : C 370 : FUNCEL = SURF * JTL(1,3) 371 : RUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 372 : RUY.AM(IFAC,1,2) = FUNCEL / VOLD 373 : C 374 : FUNCEL = SURF * JTL(1,4) 375 : RRET.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 376 : RRET.AM(IFAC,1,2) = FUNCEL / VOLD 377 : C 378 : C********** Dual RUXN 379 : C 380 : FUNCEL = SURF * JTL(2,1) 381 : UXR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 382 : UXR.AM(IFAC,1,2) = FUNCEL / VOLD 383 : C 384 : FUNCEL = SURF * JTL(2,2) 385 : UXUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 386 : UXUX.AM(IFAC,1,2) = FUNCEL / VOLD 387 : C 388 : FUNCEL = SURF * JTL(2,3) 389 : UXUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 390 : UXUY.AM(IFAC,1,2) = FUNCEL / VOLD 391 : C 392 : FUNCEL = SURF * JTL(2,4) 393 : UXRET.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 394 : UXRET.AM(IFAC,1,2) = FUNCEL / VOLD 395 : C 396 : C********** Dual RUYN 397 : C 398 : FUNCEL = SURF * JTL(3,1) 399 : UYR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 400 : UYR.AM(IFAC,1,2) = FUNCEL / VOLD 401 : C 402 : FUNCEL = SURF * JTL(3,2) 403 : UYUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 404 : UYUX.AM(IFAC,1,2) = FUNCEL / VOLD 405 : C 406 : FUNCEL = SURF * JTL(3,3) 407 : UYUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 408 : UYUY.AM(IFAC,1,2) = FUNCEL / VOLD 409 : C 410 : FUNCEL = SURF * JTL(3,4) 411 : UYRET.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 412 : UYRET.AM(IFAC,1,2) = FUNCEL / VOLD 413 : C 414 : C********** Dual RETN 415 : C 416 : FUNCEL = SURF * JTL(4,1) 417 : RETR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 418 : RETR.AM(IFAC,1,2) = FUNCEL / VOLD 419 : C 420 : FUNCEL = SURF * JTL(4,2) 421 : RETUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 422 : RETUX.AM(IFAC,1,2) = FUNCEL / VOLD 423 : C 424 : FUNCEL = SURF * JTL(4,3) 425 : RETUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 426 : RETUY.AM(IFAC,1,2) = FUNCEL / VOLD 427 : C 428 : FUNCEL = SURF * JTL(4,4) 429 : RETRET.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 430 : RETRET.AM(IFAC,1,2) = FUNCEL / VOLD 431 : C 432 : C********** Dual RN 433 : C 434 : FUNCEL = SURF * JTR(1,1) 435 : RR.AM(IFAC,2,2) = FUNCEL / VOLD 436 : RR.AM(IFAC,2,1) = -FUNCEL / VOLG 437 : C 438 : FUNCEL = SURF * JTR(1,2) 439 : RUX.AM(IFAC,2,2) = FUNCEL / VOLD 440 : RUX.AM(IFAC,2,1) = -FUNCEL / VOLG 441 : C 442 : FUNCEL = SURF * JTR(1,3) 443 : RUY.AM(IFAC,2,2) = FUNCEL / VOLD 444 : RUY.AM(IFAC,2,1) = -FUNCEL / VOLG 445 : C 446 : FUNCEL = SURF * JTR(1,4) 447 : RRET.AM(IFAC,2,2) = FUNCEL / VOLD 448 : RRET.AM(IFAC,2,1) = -FUNCEL / VOLG 449 : C 450 : C********** Dual RUXN 451 : C 452 : FUNCEL = SURF * JTR(2,1) 453 : UXR.AM(IFAC,2,2) = FUNCEL / VOLD 454 : UXR.AM(IFAC,2,1) = -FUNCEL / VOLG 455 : C 456 : FUNCEL = SURF * JTR(2,2) 457 : UXUX.AM(IFAC,2,2) = FUNCEL / VOLD 458 : UXUX.AM(IFAC,2,1) = -FUNCEL / VOLG 459 : C 460 : FUNCEL = SURF * JTR(2,3) 461 : UXUY.AM(IFAC,2,2) = FUNCEL / VOLD 462 : UXUY.AM(IFAC,2,1) = -FUNCEL / VOLG 463 : C 464 : FUNCEL = SURF * JTR(2,4) 465 : UXRET.AM(IFAC,2,2) = FUNCEL / VOLD 466 : UXRET.AM(IFAC,2,1) = -FUNCEL / VOLG 467 : C 468 : C********** Dual RUYN 469 : C 470 : FUNCEL = SURF * JTR(3,1) 471 : UYR.AM(IFAC,2,2) = FUNCEL / VOLD 472 : UYR.AM(IFAC,2,1) = -FUNCEL / VOLG 473 : C 474 : FUNCEL = SURF * JTR(3,2) 475 : UYUX.AM(IFAC,2,2) = FUNCEL / VOLD 476 : UYUX.AM(IFAC,2,1) = -FUNCEL / VOLG 477 : C 478 : FUNCEL = SURF * JTR(3,3) 479 : UYUY.AM(IFAC,2,2) = FUNCEL / VOLD 480 : UYUY.AM(IFAC,2,1) = -FUNCEL / VOLG 481 : C 482 : FUNCEL = SURF * JTR(3,4) 483 : UYRET.AM(IFAC,2,2) = FUNCEL / VOLD 484 : UYRET.AM(IFAC,2,1) = -FUNCEL / VOLG 485 : C 486 : C********** Dual RETN 487 : C 488 : FUNCEL = SURF * JTR(4,1) 489 : RETR.AM(IFAC,2,2) = FUNCEL / VOLD 490 : RETR.AM(IFAC,2,1) = -FUNCEL / VOLG 491 : C 492 : FUNCEL = SURF * JTR(4,2) 493 : RETUX.AM(IFAC,2,2) = FUNCEL / VOLD 494 : RETUX.AM(IFAC,2,1) = -FUNCEL / VOLG 495 : C 496 : FUNCEL = SURF * JTR(4,3) 497 : RETUY.AM(IFAC,2,2) = FUNCEL / VOLD 498 : RETUY.AM(IFAC,2,1) = -FUNCEL / VOLG 499 : C 500 : FUNCEL = SURF * JTR(4,4) 501 : RETRET.AM(IFAC,2,2) = FUNCEL / VOLD 502 : RETRET.AM(IFAC,2,1) = -FUNCEL / VOLG 503 : C 504 : ELSE 505 : C 506 : C********** Murs (NGCG = NGCD) 507 : C 508 : C 509 : C********** Les MELEMEs 510 : C 511 : MELEDU.NUM(1,IFAC) = NGCG 512 : MELEDU.NUM(2,IFAC) = NGCD 513 : NLCG = MLENTC.LECT(NGCG) 514 : C 515 : ROG = MPRN.VPOCHA(NLCG,1) 516 : PG = MPPN.VPOCHA(NLCG,1) 517 : UXG = MPUN.VPOCHA(NLCG,1) 518 : UYG = MPUN.VPOCHA(NLCG,2) 519 : GAMG = MPGAMN.VPOCHA(NLCG,1) 520 : VOLG = MPVOLU.VPOCHA(NLCG,1) 521 : C------------------------------------------- 522 : WVEC_L(1)=ROG 523 : WVEC_L(2)=UXG 524 : WVEC_L(3)=UYG 525 : WVEC_L(4)=PG 526 : C------------------------------------------------- 527 : SURF = MPOVSU.VPOCHA(NLCF,1) 528 : NVECT(1) = MPNORM.VPOCHA(NLCF,1) 529 : NVECT(2) = MPNORM.VPOCHA(NLCF,2) 530 : TVECT(1) =-NVECT(2) 531 : TVECT(2) = NVECT(1) 532 : C------- COEFFICIENTS ---------------------------- 533 : ZC1=NVECT(1)*TVECT(2)+TVECT(1)*NVECT(2) 534 : ZC2=NVECT(1)*TVECT(2)-TVECT(1)*NVECT(2) 535 : ZC3=2.0D0*NVECT(1)*TVECT(1) 536 : ZC4=2.0D0*NVECT(2)*TVECT(2) 537 : C------------------------------------------------- 538 : ROD = ROG 539 : PD = PG 540 : UXD = -ZC1*UXG/ZC2-ZC4*UYG/ZC2 541 : UYD = ZC3*UXG/ZC2+ZC1*UYG/ZC2 542 : VOLD = VOLG 543 : C------------------------------------------------ 544 : UPR_L=MPUPRI.VPOCHA(NLCG,1) 545 : UPR_R=UPR_L 546 : V_INF=MAX(MPUINF.VPOCHA(NLCG,1),UPR_L) 547 : C------------------------------------------------ 548 : WVEC_R(1)=ROD 549 : WVEC_R(2)=UXD 550 : WVEC_R(3)=UYD 551 : WVEC_R(4)=PD 552 : C------------------------------------------- 553 : C********** La normale sortante 554 : C------------------------------------------- 554 : CALL CONJP7(JTL,WVEC_L,WVEC_R, 555 : & NVECT,TVECT,GAMG,V_INF) 556 : C 557 : C********** Dual RN 558 : C 559 : RR.AM(IFAC,1,1) = 0.0D0 560 : RR.AM(IFAC,1,2) = 0.0D0 561 : C 562 : RUX.AM(IFAC,1,1) = 0.0D0 563 : RUX.AM(IFAC,1,2) = 0.0D0 564 : C 565 : RUY.AM(IFAC,1,1) = 0.0D0 566 : RUY.AM(IFAC,1,2) = 0.0D0 567 : C 568 : RRET.AM(IFAC,1,1) = 0.0D0 569 : RRET.AM(IFAC,1,2) = 0.0D0 570 : C 571 : C********** Dual RUXN 572 : C 573 : FUNCEL = SURF * JTL(2,1) 574 : UXR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 575 : UXR.AM(IFAC,1,2) = 0.0D0 576 : C 577 : FUNCEL = SURF * JTL(2,2) 578 : UXUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 579 : UXUX.AM(IFAC,1,2) = 0.0D0 580 : C 581 : FUNCEL = SURF * JTL(2,3) 582 : UXUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 583 : UXUY.AM(IFAC,1,2) = 0.0D0 584 : C 585 : FUNCEL = SURF * JTL(2,4) 586 : UXRET.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 587 : UXRET.AM(IFAC,1,2) = 0.0D0 588 : C 589 : C********** Dual RUYN 590 : C 591 : FUNCEL = SURF * JTL(3,1) 592 : UYR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 593 : UYR.AM(IFAC,1,2) = 0.0D0 594 : C 595 : FUNCEL = SURF * JTL(3,2) 596 : UYUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 597 : UYUX.AM(IFAC,1,2) = 0.0D0 598 : C 599 : FUNCEL = SURF * JTL(3,3) 600 : UYUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 601 : UYUY.AM(IFAC,1,2) = 0.0D0 602 : C 603 : FUNCEL = SURF * JTL(3,4) 604 : UYRET.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 605 : UYRET.AM(IFAC,1,2) = 0.0D0 606 : C 607 : C********** Dual RETN 608 : C 609 : RETR.AM(IFAC,1,1) = 0.0D0 610 : RETR.AM(IFAC,1,2) = 0.0D0 611 : C 612 : RETUX.AM(IFAC,1,1) = 0.0D0 613 : RETUX.AM(IFAC,1,2) = 0.0D0 614 : C 615 : RETUY.AM(IFAC,1,1) = 0.0D0 616 : RETUY.AM(IFAC,1,2) = 0.0D0 617 : C 618 : RETRET.AM(IFAC,1,1) = 0.0D0 619 : RETRET.AM(IFAC,1,2) = 0.0D0 620 : C 621 : C********** Dual RN 622 : C 623 : RR.AM(IFAC,2,2) = 0.0D0 624 : RR.AM(IFAC,2,1) = 0.0D0 625 : C 626 : RUX.AM(IFAC,2,2) = 0.0D0 627 : RUX.AM(IFAC,2,1) = 0.0D0 628 : C 629 : RUY.AM(IFAC,2,2) = 0.0D0 630 : RUY.AM(IFAC,2,1) = 0.0D0 631 : C 632 : RRET.AM(IFAC,2,2) = 0.0D0 633 : RRET.AM(IFAC,2,1) = 0.0D0 634 : C 635 : C********** Dual RUXN 636 : C 637 : UXR.AM(IFAC,2,2) = 0.0D0 638 : UXR.AM(IFAC,2,1) = 0.0D0 639 : C 640 : UXUX.AM(IFAC,2,2) = 0.0D0 641 : UXUX.AM(IFAC,2,1) = 0.0D0 642 : C 643 : UXUY.AM(IFAC,2,2) = 0.0D0 644 : UXUY.AM(IFAC,2,1) = 0.0D0 645 : C 646 : UXRET.AM(IFAC,2,2) = 0.0D0 647 : UXRET.AM(IFAC,2,1) = 0.0D0 648 : C 649 : C********** Dual RUYN 650 : C 651 : UYR.AM(IFAC,2,2) = 0.0D0 652 : UYR.AM(IFAC,2,1) = 0.0D0 653 : C 654 : UYUX.AM(IFAC,2,2) = 0.0D0 655 : UYUX.AM(IFAC,2,1) = 0.0D0 656 : C 657 : UYUY.AM(IFAC,2,2) = 0.0D0 658 : UYUY.AM(IFAC,2,1) = 0.0D0 659 : C 660 : UYRET.AM(IFAC,2,2) = 0.0D0 661 : UYRET.AM(IFAC,2,1) = 0.0D0 662 : C 663 : C********** Dual RETN 664 : C 665 : RETR.AM(IFAC,2,2) = 0.0D0 666 : RETR.AM(IFAC,2,1) = 0.0D0 667 : C 668 : RETUX.AM(IFAC,2,2) = 0.0D0 669 : RETUX.AM(IFAC,2,1) = 0.0D0 670 : C 671 : RETUY.AM(IFAC,2,2) = 0.0D0 672 : RETUY.AM(IFAC,2,1) = 0.0D0 673 : C 674 : RETRET.AM(IFAC,2,2) = 0.0D0 675 : RETRET.AM(IFAC,2,1) = 0.0D0 676 : C 677 : ENDIF 678 : ENDDO 679 : C 680 : SEGDES MELEMC 681 : SEGDES MELEFE 682 : SEGDES MELEMF 683 : C 684 : SEGDES MPOVSU 685 : SEGDES MPVOLU 686 : SEGDES MPNORM 687 : C 688 : SEGDES MPRN 689 : SEGDES MPPN 690 : SEGDES MPUN 691 : SEGDES MPGAMN 692 : C 693 : SEGDES MELEDU 694 : SEGDES MATRIK 695 : SEGDES IMATRI 696 : C 697 : SEGDES RR , RUX , RUY , RRET , 698 : & UXR , UXUX , UXUY , UXRET , 699 : & UYR , UYUX , UYUY , UYRET , 700 : & RETR , RETUX , RETUY , RETRET 701 : 702 : SEGSUP MLENTC 703 : SEGSUP MLENTF 704 : SEGSUP MLELIM 705 : C 706 : SEGDES MPUPRI 707 : SEGDES MPUINF 708 : C 709 : 9999 CONTINUE 710 : RETURN 711 : END 712 : 713 : 714 : 715 : 716 : 717 :
© Cast3M 2003 - All rights reserved.
Disclaimer