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