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