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