1 : C KONJA1 SOURCE MAGN 09/07/30 21:17:43 6458 2 : SUBROUTINE KONJA1(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 : KONJA1 10 : C 11 : C DESCRIPTION : Voir KONV11 12 : C Calcul du jacobien du résidu pour la méthode de 13 : C VLH 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, DRN/DMT/SEMT/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) : VLHJ0, VLHJ2 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, RETG, GAMG, VOLG 99 : & , ROD, PD, UXD, UYD, RETD, GAMD, VOLD 100 : & , SURF, CNX, CNY, CTX, CTY, FUNCEL 101 : & , DFRO(4), DFRET(4), DFRUN(4), DFRUT(4) 102 : CHARACTER*8 TYPE 103 : C 104 : C**** LES INCLUDES 105 : C 106 : -INC CCOPTIO 107 : -INC SMCHPOI 108 : -INC SMMATRIK 109 : -INC SMELEME 110 : -INC SMLMOTS 111 : -INC SMLENTI 112 : POINTEUR MPRN.MPOVAL, MPUN.MPOVAL, MPPN.MPOVAL, MPGAMN.MPOVAL, 113 : & MPNORM.MPOVAL, MPVOLU.MPOVAL, MPOVSU.MPOVAL 114 : POINTEUR MELEMC.MELEME, MELEMF.MELEME, MELEFE.MELEME, 115 : & MELEDU.MELEME,MELLIM.MELEME 116 : POINTEUR MLENTC.MLENTI, MLENTF.MLENTI, MLELIM.MLENTI 117 : POINTEUR RR.IZAFM, RUX.IZAFM, RUY.IZAFM, RRET.IZAFM, 118 : & UXR.IZAFM, UXUX.IZAFM, UXUY.IZAFM, UXRET.IZAFM, 119 : & UYR.IZAFM, UYUX.IZAFM, UYUY.IZAFM, UYRET.IZAFM, 120 : & RETR.IZAFM, RETUX.IZAFM, RETUY.IZAFM, RETRET.IZAFM 121 : POINTEUR MLMINC.MLMOTS 122 : C 123 : C**** KRIPAD pour la correspondance global/local des conditions limits 124 : C 124 : CALL KRIPAD(MELLIM,MLELIM) 125 : C SEGACT MELLIM 126 : C 127 : C**** KRIPAD pour la correspondance global/local des centres 128 : C 128 : CALL KRIPAD(MELEMC,MLENTC) 129 : C 130 : C SEGACT MLENTC 131 : SEGACT MELEMC 132 : C 133 : SEGACT MELEFE 134 : C 134 : CALL LICHT(ICHPSU,MPOVSU,TYPE,IGEOMF) 134 : CALL LICHT(INORM,MPNORM,TYPE,IGEOMF) 134 : CALL LICHT(ICHPVO,MPVOLU,TYPE,IGEOMC) 135 : C 136 : C**** LICHT active les MPOVALs en *MOD 137 : C 138 : C i.e. 139 : C 140 : C SEGACT MPOVSU*MOD 141 : C SEGACT MPOVNO*MOD 142 : C SEGACT MPVOLU*MOD 143 : C 144 : MELEMF = IGEOMF 144 : CALL KRIPAD(MELEMF,MLENTF) 145 : C 146 : C SEGACT MLENTF 147 : SEGACT MELEMF 148 : C 148 : CALL LICHT(IRN,MPRN,TYPE,IGEOMC) 148 : CALL LICHT(IPN,MPPN,TYPE,IGEOMC) 148 : CALL LICHT(IUN,MPUN,TYPE,IGEOMC) 148 : CALL LICHT(IGAMN,MPGAMN,TYPE,IGEOMC) 149 : C 150 : C SEGACT MPRN*MOD 151 : C SEGACT MPPN*MOD 152 : C SEGACT MPUN*MOD 153 : C SEGACT MPGAMN*MOD 154 : C 155 : NFAC = MELEFE.NUM(/2) 156 : C 157 : C**** Maillage des inconnues primales 158 : C 159 : NBSOUS = 0 160 : NBREF = 0 161 : NBELEM = NFAC 162 : NBNN = 2 163 : C 164 : SEGINI MELEDU 165 : C MELEPR = MELEDU 166 : C 167 : C**** MELEDU = 'SEG2' 168 : C 169 : MELEDU.ITYPEL = 2 170 : C 171 : NRIGE = 7 172 : NMATRI = 1 173 : NKID = 9 174 : NKMT = 7 175 : C 176 : SEGINI MATRIK 177 : IMAT = MATRIK 178 : MATRIK.IRIGEL(1,1) = MELEDU 179 : MATRIK.IRIGEL(2,1) = MELEDU 180 : C 181 : C**** Matrice non symetrique 182 : C 183 : MATRIK.IRIGEL(7,1) = 2 184 : C 185 : NBME = 16 186 : NBSOUS = 1 187 : SEGINI IMATRI 188 : MLMINC = ILINC 189 : SEGACT MLMINC 190 : MATRIK.IRIGEL(4,1) = IMATRI 191 : C 192 : IMATRI.LISPRI(1) = MLMINC.MOTS(1) 193 : IMATRI.LISPRI(2) = MLMINC.MOTS(2) 194 : IMATRI.LISPRI(3) = MLMINC.MOTS(3) 195 : IMATRI.LISPRI(4) = MLMINC.MOTS(4) 196 : IMATRI.LISPRI(5) = MLMINC.MOTS(1) 197 : IMATRI.LISPRI(6) = MLMINC.MOTS(2) 198 : IMATRI.LISPRI(7) = MLMINC.MOTS(3) 199 : IMATRI.LISPRI(8) = MLMINC.MOTS(4) 200 : IMATRI.LISPRI(9) = MLMINC.MOTS(1) 201 : IMATRI.LISPRI(10) = MLMINC.MOTS(2) 202 : IMATRI.LISPRI(11) = MLMINC.MOTS(3) 203 : IMATRI.LISPRI(12) = MLMINC.MOTS(4) 204 : IMATRI.LISPRI(13) = MLMINC.MOTS(1) 205 : IMATRI.LISPRI(14) = MLMINC.MOTS(2) 206 : IMATRI.LISPRI(15) = MLMINC.MOTS(3) 207 : IMATRI.LISPRI(16) = MLMINC.MOTS(4) 208 : C 209 : IMATRI.LISDUA(1) = MLMINC.MOTS(1) 210 : IMATRI.LISDUA(2) = MLMINC.MOTS(1) 211 : IMATRI.LISDUA(3) = MLMINC.MOTS(1) 212 : IMATRI.LISDUA(4) = MLMINC.MOTS(1) 213 : IMATRI.LISDUA(5) = MLMINC.MOTS(2) 214 : IMATRI.LISDUA(6) = MLMINC.MOTS(2) 215 : IMATRI.LISDUA(7) = MLMINC.MOTS(2) 216 : IMATRI.LISDUA(8) = MLMINC.MOTS(2) 217 : IMATRI.LISDUA(9) = MLMINC.MOTS(3) 218 : IMATRI.LISDUA(10) = MLMINC.MOTS(3) 219 : IMATRI.LISDUA(11) = MLMINC.MOTS(3) 220 : IMATRI.LISDUA(12) = MLMINC.MOTS(3) 221 : IMATRI.LISDUA(13) = MLMINC.MOTS(4) 222 : IMATRI.LISDUA(14) = MLMINC.MOTS(4) 223 : IMATRI.LISDUA(15) = MLMINC.MOTS(4) 224 : IMATRI.LISDUA(16) = MLMINC.MOTS(4) 225 : C 226 : NBEL = NBELEM 227 : NBSOUS = 1 228 : NP = 2 229 : MP = 2 230 : SEGINI RR , RUX , RUY , RRET , 231 : & UXR , UXUX , UXUY , UXRET , 232 : & UYR , UYUX , UYUY , UYRET , 233 : & RETR , RETUX , RETUY , RETRET 234 : C 235 : C**** Duale = IMATRI.LISDUA(1) = 'RN' 236 : C Primale = IMATRI.LISPRI(1) = 'RN' 237 : C -> IMATRI.LIZAFM(1,1) = RR 238 : C 239 : C Duale = IMATRI.LISDUA(2) = 'RN' 240 : C Primale = IMATRI.LISPRI(1) = 'RUXN' 241 : C -> IMATRI.LIZAFM(1,2) = RUX 242 : C ... 243 : C 244 : IMATRI.LIZAFM(1,1) = RR 245 : IMATRI.LIZAFM(1,2) = RUX 246 : IMATRI.LIZAFM(1,3) = RUY 247 : IMATRI.LIZAFM(1,4) = RRET 248 : IMATRI.LIZAFM(1,5) = UXR 249 : IMATRI.LIZAFM(1,6) = UXUX 250 : IMATRI.LIZAFM(1,7) = UXUY 251 : IMATRI.LIZAFM(1,8) = UXRET 252 : IMATRI.LIZAFM(1,9) = UYR 253 : IMATRI.LIZAFM(1,10) = UYUX 254 : IMATRI.LIZAFM(1,11) = UYUY 255 : IMATRI.LIZAFM(1,12) = UYRET 256 : IMATRI.LIZAFM(1,13) = RETR 257 : IMATRI.LIZAFM(1,14) = RETUX 258 : IMATRI.LIZAFM(1,15) = RETUY 259 : IMATRI.LIZAFM(1,16) = RETRET 260 : C 261 : DO IFAC = 1, NFAC, 1 262 : NGCF = MELEFE.NUM(2,IFAC) 263 : NLCF = MLENTF.LECT(NGCF) 264 : IF(NLCF .NE. IFAC)THEN 265 : WRITE(IOIMP,*) 'Il ne faut pas jouer avec la table domaine' 265 : CALL ERREUR(5) 266 : GOTO 9999 267 : ENDIF 268 : NLFL = MLELIM.LECT(NGCF) 269 : NGCG = MELEFE.NUM(1,IFAC) 270 : NGCD = MELEFE.NUM(3,IFAC) 271 : IF(NLFL .NE. 0)THEN 272 : C 273 : C********** The point belongs on BC -> No contribution to jacobian! 274 : C 275 : MELEDU.NUM(1,IFAC) = NGCG 276 : MELEDU.NUM(2,IFAC) = NGCD 277 : ELSEIF(NGCG .NE. NGCD)THEN 278 : C 279 : C********** Les MELEMEs 280 : C 281 : MELEDU.NUM(1,IFAC) = NGCG 282 : MELEDU.NUM(2,IFAC) = NGCD 283 : C 284 : C********** Les etats G et D 285 : C 286 : NLCG = MLENTC.LECT(NGCG) 287 : NLCD = MLENTC.LECT(NGCD) 288 : C 289 : ROG = MPRN.VPOCHA(NLCG,1) 290 : PG = MPPN.VPOCHA(NLCG,1) 291 : UXG = MPUN.VPOCHA(NLCG,1) 292 : UYG = MPUN.VPOCHA(NLCG,2) 293 : GAMG = MPGAMN.VPOCHA(NLCG,1) 294 : RETG= (PG / (GAMG - 1.0D0)) + 0.5D0 * ROG * (UXG * UXG + 295 : & UYG * UYG) 296 : VOLG = MPVOLU.VPOCHA(NLCG,1) 297 : C 298 : ROD = MPRN.VPOCHA(NLCD,1) 299 : PD = MPPN.VPOCHA(NLCD,1) 300 : UXD = MPUN.VPOCHA(NLCD,1) 301 : UYD = MPUN.VPOCHA(NLCD,2) 302 : GAMD = MPGAMN.VPOCHA(NLCD,1) 303 : RETD= (PD / (GAMD - 1.0D0)) + 0.5D0 * ROD * (UXD * UXD + 304 : & UYD * UYD) 305 : VOLD = MPVOLU.VPOCHA(NLCD,1) 306 : C 307 : C********** La normale G->D 308 : C La tangente 309 : C 310 : SURF = MPOVSU.VPOCHA(NLCF,1) 311 : CNX = MPNORM.VPOCHA(NLCF,1) 312 : CNY = MPNORM.VPOCHA(NLCF,2) 313 : CTX = -1.0D0 * CNY 314 : CTY = CNX 315 : C 316 : C********** La contribution de Gauche 317 : C 317 : CALL VLHJ0(ROG,UXG,UYG,PG,RETG,GAMG,CNX,CNY,CTX,CTY, 318 : & DFRO,DFRUN,DFRUT,DFRET) 319 : C 320 : C 321 : C********** AB.AM(IFAC,IPRIM,IDUAL) 322 : C A = nom de l'inconnu duale (Ro,rUX,rUY,RET) 323 : C B = nom de l'inconnu primale (Ro,rUX,rUY,RET) 324 : C IPRIM = 1, 2 -> G, D 325 : C IDUAL = 1, 2 -> G, D 326 : C i.e. 327 : C A_IDUAL = AB.AM(IFAC,IPRIM,IDUAL) * B_IPRIM + ... 328 : C 329 : C 330 : C********** Dual RN 331 : C 332 : FUNCEL = SURF * DFRO(1) 333 : RR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 334 : RR.AM(IFAC,1,2) = FUNCEL / VOLD 335 : C 336 : FUNCEL = SURF * DFRO(2) 337 : RUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 338 : RUX.AM(IFAC,1,2) = FUNCEL / VOLD 339 : C 340 : FUNCEL = SURF * DFRO(3) 341 : RUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 342 : RUY.AM(IFAC,1,2) = FUNCEL / VOLD 343 : C 344 : FUNCEL = SURF * DFRO(4) 345 : RRET.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 346 : RRET.AM(IFAC,1,2) = FUNCEL / VOLD 347 : C 348 : C********** Dual RUXN 349 : C 350 : FUNCEL = SURF * (DFRUN(1) * CNX + DFRUT(1) * CTX) 351 : UXR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 352 : UXR.AM(IFAC,1,2) = FUNCEL / VOLD 353 : C 354 : FUNCEL = SURF * (DFRUN(2) * CNX + DFRUT(2) * CTX) 355 : UXUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 356 : UXUX.AM(IFAC,1,2) = FUNCEL / VOLD 357 : C 358 : FUNCEL = SURF * (DFRUN(3) * CNX + DFRUT(3) * CTX) 359 : UXUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 360 : UXUY.AM(IFAC,1,2) = FUNCEL / VOLD 361 : C 362 : FUNCEL = SURF * (DFRUN(4) * CNX + DFRUT(4) * CTX) 363 : UXRET.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 364 : UXRET.AM(IFAC,1,2) = FUNCEL / VOLD 365 : C 366 : C********** Dual RUYN 367 : C 368 : FUNCEL = SURF * (DFRUN(1) * CNY + DFRUT(1) * CTY) 369 : UYR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 370 : UYR.AM(IFAC,1,2) = FUNCEL / VOLD 371 : C 372 : FUNCEL = SURF * (DFRUN(2) * CNY + DFRUT(2) * CTY) 373 : UYUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 374 : UYUX.AM(IFAC,1,2) = FUNCEL / VOLD 375 : C 376 : FUNCEL = SURF * (DFRUN(3) * CNY + DFRUT(3) * CTY) 377 : UYUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 378 : UYUY.AM(IFAC,1,2) = FUNCEL / VOLD 379 : C 380 : FUNCEL = SURF * (DFRUN(4) * CNY + DFRUT(4) * CTY) 381 : UYRET.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 382 : UYRET.AM(IFAC,1,2) = FUNCEL / VOLD 383 : C 384 : C********** Dual RETN 385 : C 386 : FUNCEL = SURF * DFRET(1) 387 : RETR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 388 : RETR.AM(IFAC,1,2) = FUNCEL / VOLD 389 : C 390 : FUNCEL = SURF * DFRET(2) 391 : RETUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 392 : RETUX.AM(IFAC,1,2) = FUNCEL / VOLD 393 : C 394 : FUNCEL = SURF * DFRET(3) 395 : RETUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 396 : RETUY.AM(IFAC,1,2) = FUNCEL / VOLD 397 : C 398 : FUNCEL = SURF * DFRET(4) 399 : RETRET.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 400 : RETRET.AM(IFAC,1,2) = FUNCEL / VOLD 401 : C 402 : C 403 : C********** La contribution de D 404 : C 405 : CNX = -1.0D0 * CNX 406 : CNY = -1.0D0 * CNY 407 : CTX = -1.0D0 * CTX 408 : CTY = -1.0D0 * CTY 409 : 409 : CALL VLHJ0(ROD,UXD,UYD,PD,RETD,GAMD,CNX,CNY,CTX,CTY, 410 : & DFRO,DFRUN,DFRUT,DFRET) 411 : C 412 : C 413 : C********** Dual RN 414 : C 415 : FUNCEL = SURF * DFRO(1) 416 : RR.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD 417 : RR.AM(IFAC,2,1) = FUNCEL / VOLG 418 : C 419 : FUNCEL = SURF * DFRO(2) 420 : RUX.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD 421 : RUX.AM(IFAC,2,1) = FUNCEL / VOLG 422 : C 423 : FUNCEL = SURF * DFRO(3) 424 : RUY.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD 425 : RUY.AM(IFAC,2,1) = FUNCEL / VOLG 426 : C 427 : FUNCEL = SURF * DFRO(4) 428 : RRET.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD 429 : RRET.AM(IFAC,2,1) = FUNCEL / VOLG 430 : C 431 : C********** Dual RUXN 432 : C 433 : FUNCEL = SURF * (DFRUN(1) * CNX + DFRUT(1) * CTX) 434 : UXR.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD 435 : UXR.AM(IFAC,2,1) = FUNCEL / VOLG 436 : C 437 : FUNCEL = SURF * (DFRUN(2) * CNX + DFRUT(2) * CTX) 438 : UXUX.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD 439 : UXUX.AM(IFAC,2,1) = FUNCEL / VOLG 440 : C 441 : FUNCEL = SURF * (DFRUN(3) * CNX + DFRUT(3) * CTX) 442 : UXUY.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD 443 : UXUY.AM(IFAC,2,1) = FUNCEL / VOLG 444 : C 445 : FUNCEL = SURF * (DFRUN(4) * CNX + DFRUT(4) * CTX) 446 : UXRET.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD 447 : UXRET.AM(IFAC,2,1) = FUNCEL / VOLG 448 : C 449 : C********** Dual RUYN 450 : C 451 : FUNCEL = SURF * (DFRUN(1) * CNY + DFRUT(1) * CTY) 452 : UYR.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD 453 : UYR.AM(IFAC,2,1) = FUNCEL / VOLG 454 : C 455 : FUNCEL = SURF * (DFRUN(2) * CNY + DFRUT(2) * CTY) 456 : UYUX.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD 457 : UYUX.AM(IFAC,2,1) = FUNCEL / VOLG 458 : C 459 : FUNCEL = SURF * (DFRUN(3) * CNY + DFRUT(3) * CTY) 460 : UYUY.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD 461 : UYUY.AM(IFAC,2,1) = FUNCEL / VOLG 462 : C 463 : FUNCEL = SURF * (DFRUN(4) * CNY + DFRUT(4) * CTY) 464 : UYRET.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD 465 : UYRET.AM(IFAC,2,1) = FUNCEL / VOLG 466 : C 467 : C********** Dual RETN 468 : C 469 : FUNCEL = SURF * DFRET(1) 470 : RETR.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD 471 : RETR.AM(IFAC,2,1) = FUNCEL / VOLG 472 : C 473 : FUNCEL = SURF * DFRET(2) 474 : RETUX.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD 475 : RETUX.AM(IFAC,2,1) = FUNCEL / VOLG 476 : C 477 : FUNCEL = SURF * DFRET(3) 478 : RETUY.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD 479 : RETUY.AM(IFAC,2,1) = FUNCEL / VOLG 480 : C 481 : FUNCEL = SURF * DFRET(4) 482 : RETRET.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD 483 : RETRET.AM(IFAC,2,1) = FUNCEL / VOLG 484 : C 485 : ELSE 486 : C 487 : C********** Murs (NGCG = NGCD) 488 : C 489 : C 490 : C********** Les MELEMEs 491 : C 492 : MELEDU.NUM(1,IFAC) = NGCG 493 : MELEDU.NUM(2,IFAC) = NGCD 494 : NLCG = MLENTC.LECT(NGCG) 495 : C 496 : ROG = MPRN.VPOCHA(NLCG,1) 497 : PG = MPPN.VPOCHA(NLCG,1) 498 : UXG = MPUN.VPOCHA(NLCG,1) 499 : UYG = MPUN.VPOCHA(NLCG,2) 500 : GAMG = MPGAMN.VPOCHA(NLCG,1) 501 : VOLG = MPVOLU.VPOCHA(NLCG,1) 502 : C 503 : C********** La normale sortante 504 : C 505 : SURF = MPOVSU.VPOCHA(NLCF,1) 506 : CNX = MPNORM.VPOCHA(NLCF,1) 507 : CNY = MPNORM.VPOCHA(NLCF,2) 508 : C 508 : CALL VLHJ2(ROG,UXG,UYG,PG,GAMG,CNX,CNY, 509 : & DFRUN) 510 : C 511 : C********** Dual RN 512 : C 513 : RR.AM(IFAC,1,1) = 0.0D0 514 : RR.AM(IFAC,1,2) = 0.0D0 515 : C 516 : RUX.AM(IFAC,1,1) = 0.0D0 517 : RUX.AM(IFAC,1,2) = 0.0D0 518 : C 519 : RUY.AM(IFAC,1,1) = 0.0D0 520 : RUY.AM(IFAC,1,2) = 0.0D0 521 : C 522 : RRET.AM(IFAC,1,1) = 0.0D0 523 : RRET.AM(IFAC,1,2) = 0.0D0 524 : C 525 : C********** Dual RUXN 526 : C 527 : FUNCEL = SURF * DFRUN(1) * CNX 528 : UXR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 529 : UXR.AM(IFAC,1,2) = 0.0D0 530 : C 531 : FUNCEL = SURF * DFRUN(2) * CNX 532 : UXUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 533 : UXUX.AM(IFAC,1,2) = 0.0D0 534 : C 535 : FUNCEL = SURF * DFRUN(3) * CNX 536 : UXUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 537 : UXUY.AM(IFAC,1,2) = 0.0D0 538 : C 539 : FUNCEL = SURF * DFRUN(4) * CNX 540 : UXRET.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 541 : UXRET.AM(IFAC,1,2) = 0.0D0 542 : C 543 : C********** Dual RUYN 544 : C 545 : FUNCEL = SURF * DFRUN(1) * CNY 546 : UYR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 547 : UYR.AM(IFAC,1,2) = 0.0D0 548 : C 549 : FUNCEL = SURF * DFRUN(2) * CNY 550 : UYUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 551 : UYUX.AM(IFAC,1,2) = 0.0D0 552 : C 553 : FUNCEL = SURF * DFRUN(3) * CNY 554 : UYUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 555 : UYUY.AM(IFAC,1,2) = 0.0D0 556 : C 557 : FUNCEL = SURF * DFRUN(4) * CNY 558 : UYRET.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 559 : UYRET.AM(IFAC,1,2) = 0.0D0 560 : C 561 : C********** Dual RETN 562 : C 563 : RETR.AM(IFAC,1,1) = 0.0D0 564 : RETR.AM(IFAC,1,2) = 0.0D0 565 : C 566 : RETUX.AM(IFAC,1,1) = 0.0D0 567 : RETUX.AM(IFAC,1,2) = 0.0D0 568 : C 569 : RETUY.AM(IFAC,1,1) = 0.0D0 570 : RETUY.AM(IFAC,1,2) = 0.0D0 571 : C 572 : RETRET.AM(IFAC,1,1) = 0.0D0 573 : RETRET.AM(IFAC,1,2) = 0.0D0 574 : C 575 : C********** Dual RN 576 : C 577 : RR.AM(IFAC,2,2) = 0.0D0 578 : RR.AM(IFAC,2,1) = 0.0D0 579 : C 580 : RUX.AM(IFAC,2,2) = 0.0D0 581 : RUX.AM(IFAC,2,1) = 0.0D0 582 : C 583 : RUY.AM(IFAC,2,2) = 0.0D0 584 : RUY.AM(IFAC,2,1) = 0.0D0 585 : C 586 : RRET.AM(IFAC,2,2) = 0.0D0 587 : RRET.AM(IFAC,2,1) = 0.0D0 588 : C 589 : C********** Dual RUXN 590 : C 591 : UXR.AM(IFAC,2,2) = 0.0D0 592 : UXR.AM(IFAC,2,1) = 0.0D0 593 : C 594 : UXUX.AM(IFAC,2,2) = 0.0D0 595 : UXUX.AM(IFAC,2,1) = 0.0D0 596 : C 597 : UXUY.AM(IFAC,2,2) = 0.0D0 598 : UXUY.AM(IFAC,2,1) = 0.0D0 599 : C 600 : UXRET.AM(IFAC,2,2) = 0.0D0 601 : UXRET.AM(IFAC,2,1) = 0.0D0 602 : C 603 : C********** Dual RUYN 604 : C 605 : UYR.AM(IFAC,2,2) = 0.0D0 606 : UYR.AM(IFAC,2,1) = 0.0D0 607 : C 608 : UYUX.AM(IFAC,2,2) = 0.0D0 609 : UYUX.AM(IFAC,2,1) = 0.0D0 610 : C 611 : UYUY.AM(IFAC,2,2) = 0.0D0 612 : UYUY.AM(IFAC,2,1) = 0.0D0 613 : C 614 : UYRET.AM(IFAC,2,2) = 0.0D0 615 : UYRET.AM(IFAC,2,1) = 0.0D0 616 : C 617 : C********** Dual RETN 618 : C 619 : RETR.AM(IFAC,2,2) = 0.0D0 620 : RETR.AM(IFAC,2,1) = 0.0D0 621 : C 622 : RETUX.AM(IFAC,2,2) = 0.0D0 623 : RETUX.AM(IFAC,2,1) = 0.0D0 624 : C 625 : RETUY.AM(IFAC,2,2) = 0.0D0 626 : RETUY.AM(IFAC,2,1) = 0.0D0 627 : C 628 : RETRET.AM(IFAC,2,2) = 0.0D0 629 : RETRET.AM(IFAC,2,1) = 0.0D0 630 : C 631 : ENDIF 632 : ENDDO 633 : C 634 : SEGDES MELEMC 635 : SEGDES MELEFE 636 : SEGDES MELEMF 637 : C 638 : SEGDES MPOVSU 639 : SEGDES MPVOLU 640 : SEGDES MPNORM 641 : C 642 : SEGDES MPRN 643 : SEGDES MPPN 644 : SEGDES MPUN 645 : SEGDES MPGAMN 646 : C 647 : SEGDES MELEDU 648 : SEGDES MATRIK 649 : SEGDES IMATRI 650 : C 651 : SEGDES RR , RUX , RUY , RRET , 652 : & UXR , UXUX , UXUY , UXRET , 653 : & UYR , UYUX , UYUY , UYRET , 654 : & RETR , RETUX , RETUY , RETRET 655 : 656 : SEGSUP MLENTC 657 : SEGSUP MLENTF 658 : SEGDES MLMINC 659 : SEGSUP MLELIM 660 : C 661 : 9999 CONTINUE 662 : RETURN 663 : END 664 : 665 : 666 : 667 : 668 : 669 :
© Cast3M 2003 - All rights reserved.
Disclaimer