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