1 : C KONJP3 SOURCE MAGN 09/07/30 21:18:14 6458 2 : SUBROUTINE KONJP3(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 : KONJA3 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 3D, gaz "calorically perfect" 16 : C 17 : C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI) 18 : C 19 : C AUTEUR : A. BECCANTINI, 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) : VLHJ5, VLHJ7 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 ICHPOVO : CHPOINT VOLUME contenant le volume 50 : C 51 : C ICHPOSU : 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, UZG, RETG, GAMG, VOLG 102 : & , ROD, PD, UXD, UYD, UZD, RETD, GAMD, VOLD 103 : & , SURF, CNX, CNY, CNZ, CT1X, CT1Y, CT1Z, CT2X, CT2Y, CT2Z 104 : & , FUNCEL 105 : & , DFRO(5), DFRET(5), DFRUN(5), DFRUT1(5), DFRUT2(5) 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, RUZ.IZAFM, RP.IZAFM, 122 : & UXR.IZAFM, UXUX.IZAFM, UXUY.IZAFM, UXUZ.IZAFM, UXP.IZAFM, 123 : & UYR.IZAFM, UYUX.IZAFM, UYUY.IZAFM, UYUZ.IZAFM, UYP.IZAFM, 124 : & UZR.IZAFM, UZUX.IZAFM, UZUY.IZAFM, UZUZ.IZAFM, UZP.IZAFM, 125 : & RETR.IZAFM, RETUX.IZAFM, RETUY.IZAFM, RETUZ.IZAFM, 126 : & RETP.IZAFM 127 : POINTEUR MLMINC.MLMOTS 128 : C 129 : C**** KRIPAD pour la correspondance global/local des conditions limits 130 : C 130 : CALL KRIPAD(MELLIM,MLELIM) 131 : c SEGACT MELLIM 132 : C 133 : C**** KRIPAD pour la correspondance global/local des centres 134 : C 134 : CALL KRIPAD(MELEMC,MLENTC) 135 : C 136 : C SEGACT MLENTC 137 : SEGACT MELEMC 138 : C 139 : SEGACT MELEFE 140 : C 140 : CALL LICHT(ICHPSU,MPOVSU,TYPE,IGEOMF) 140 : CALL LICHT(INORM,MPNORM,TYPE,IGEOMF) 140 : CALL LICHT(ICHPVO,MPVOLU,TYPE,IGEOMC) 141 : C 142 : C**** LICHT active les MPOVALs en *MOD 143 : C 144 : C i.e. 145 : C 146 : C SEGACT MPOVSU*MOD 147 : C SEGACT MPOVNO*MOD 148 : C SEGACT MPVOLU*MOD 149 : C 150 : MELEMF = IGEOMF 150 : CALL KRIPAD(MELEMF,MLENTF) 151 : C 152 : C SEGACT MLENTF 153 : SEGACT MELEMF 154 : C 154 : CALL LICHT(IRN,MPRN,TYPE,IGEOMC) 154 : CALL LICHT(IPN,MPPN,TYPE,IGEOMC) 154 : CALL LICHT(IUN,MPUN,TYPE,IGEOMC) 154 : CALL LICHT(IGAMN,MPGAMN,TYPE,IGEOMC) 155 : C 156 : C SEGACT MPRN*MOD 157 : C SEGACT MPPN*MOD 158 : C SEGACT MPUN*MOD 159 : C SEGACT MPGAMN*MOD 160 : C 161 : NFAC = MELEFE.NUM(/2) 162 : C 163 : C**** Maillage des inconnues primales 164 : C 165 : NBSOUS = 0 166 : NBREF = 0 167 : NBELEM = NFAC 168 : NBNN = 2 169 : C 170 : SEGINI MELEDU 171 : C MELEPR = MELEDU 172 : C 173 : C**** MELEDU = 'SEG2' 174 : C 175 : MELEDU.ITYPEL = 2 176 : C 177 : NRIGE = 7 178 : NMATRI = 1 179 : NKID = 9 180 : NKMT = 7 181 : C 182 : SEGINI MATRIK 183 : IMAT = MATRIK 184 : MATRIK.IRIGEL(1,1) = MELEDU 185 : MATRIK.IRIGEL(2,1) = MELEDU 186 : C 187 : C**** Matrice non symetrique 188 : C 189 : MATRIK.IRIGEL(7,1) = 2 190 : C 191 : NBME = 25 192 : NBSOUS = 1 193 : SEGINI IMATRI 194 : MATRIK.IRIGEL(4,1) = IMATRI 195 : C 196 : C**** Variables primales (primitives) 197 : C 198 : MLMINC = ILINP 199 : SEGACT MLMINC 200 : IMATRI.LISPRI(1) = MLMINC.MOTS(1) 201 : IMATRI.LISPRI(2) = MLMINC.MOTS(2) 202 : IMATRI.LISPRI(3) = MLMINC.MOTS(3) 203 : IMATRI.LISPRI(4) = MLMINC.MOTS(4) 204 : IMATRI.LISPRI(5) = MLMINC.MOTS(5) 205 : C 206 : IMATRI.LISPRI(6) = MLMINC.MOTS(1) 207 : IMATRI.LISPRI(7) = MLMINC.MOTS(2) 208 : IMATRI.LISPRI(8) = MLMINC.MOTS(3) 209 : IMATRI.LISPRI(9) = MLMINC.MOTS(4) 210 : IMATRI.LISPRI(10) = MLMINC.MOTS(5) 211 : C 212 : IMATRI.LISPRI(11) = MLMINC.MOTS(1) 213 : IMATRI.LISPRI(12) = MLMINC.MOTS(2) 214 : IMATRI.LISPRI(13) = MLMINC.MOTS(3) 215 : IMATRI.LISPRI(14) = MLMINC.MOTS(4) 216 : IMATRI.LISPRI(15) = MLMINC.MOTS(5) 217 : C 218 : IMATRI.LISPRI(16) = MLMINC.MOTS(1) 219 : IMATRI.LISPRI(17) = MLMINC.MOTS(2) 220 : IMATRI.LISPRI(18) = MLMINC.MOTS(3) 221 : IMATRI.LISPRI(19) = MLMINC.MOTS(4) 222 : IMATRI.LISPRI(20) = MLMINC.MOTS(5) 223 : C 224 : IMATRI.LISPRI(21) = MLMINC.MOTS(1) 225 : IMATRI.LISPRI(22) = MLMINC.MOTS(2) 226 : IMATRI.LISPRI(23) = MLMINC.MOTS(3) 227 : IMATRI.LISPRI(24) = MLMINC.MOTS(4) 228 : IMATRI.LISPRI(25) = MLMINC.MOTS(5) 229 : SEGDES MLMINC 230 : C 231 : C**** Variables duales (conservatives) 232 : C 233 : MLMINC = ILINC 234 : SEGACT MLMINC 235 : IMATRI.LISDUA(1) = MLMINC.MOTS(1) 236 : IMATRI.LISDUA(2) = MLMINC.MOTS(1) 237 : IMATRI.LISDUA(3) = MLMINC.MOTS(1) 238 : IMATRI.LISDUA(4) = MLMINC.MOTS(1) 239 : IMATRI.LISDUA(5) = MLMINC.MOTS(1) 240 : C 241 : IMATRI.LISDUA(6) = MLMINC.MOTS(2) 242 : IMATRI.LISDUA(7) = MLMINC.MOTS(2) 243 : IMATRI.LISDUA(8) = MLMINC.MOTS(2) 244 : IMATRI.LISDUA(9) = MLMINC.MOTS(2) 245 : IMATRI.LISDUA(10) = MLMINC.MOTS(2) 246 : C 247 : IMATRI.LISDUA(11) = MLMINC.MOTS(3) 248 : IMATRI.LISDUA(12) = MLMINC.MOTS(3) 249 : IMATRI.LISDUA(13) = MLMINC.MOTS(3) 250 : IMATRI.LISDUA(14) = MLMINC.MOTS(3) 251 : IMATRI.LISDUA(15) = MLMINC.MOTS(3) 252 : C 253 : IMATRI.LISDUA(16) = MLMINC.MOTS(4) 254 : IMATRI.LISDUA(17) = MLMINC.MOTS(4) 255 : IMATRI.LISDUA(18) = MLMINC.MOTS(4) 256 : IMATRI.LISDUA(19) = MLMINC.MOTS(4) 257 : IMATRI.LISDUA(20) = MLMINC.MOTS(4) 258 : C 259 : IMATRI.LISDUA(21) = MLMINC.MOTS(5) 260 : IMATRI.LISDUA(22) = MLMINC.MOTS(5) 261 : IMATRI.LISDUA(23) = MLMINC.MOTS(5) 262 : IMATRI.LISDUA(24) = MLMINC.MOTS(5) 263 : IMATRI.LISDUA(25) = MLMINC.MOTS(5) 264 : SEGDES MLMINC 265 : C 266 : NBEL = NBELEM 267 : NBSOUS = 1 268 : NP = 2 269 : MP = 2 270 : SEGINI RR , RUX , RUY , RUZ, RP , 271 : & UXR , UXUX , UXUY , UXUZ, UXP , 272 : & UYR , UYUX , UYUY , UYUZ, UYP , 273 : & UZR , UZUX , UZUY , UZUZ, UZP , 274 : & RETR , RETUX , RETUY , RETUZ, RETP 275 : C 276 : C**** Duale = IMATRI.LISDUA(1) = 'RN' 277 : C Primale = IMATRI.LISPRI(1) = 'RN' 278 : C -> IMATRI.LIZAFM(1,1) = RR 279 : C 280 : C Duale = IMATRI.LISDUA(2) = 'RN' 281 : C Primale = IMATRI.LISPRI(1) = 'RUXN' 282 : C -> IMATRI.LIZAFM(1,2) = RUX 283 : C ... 284 : C 285 : IMATRI.LIZAFM(1,1) = RR 286 : IMATRI.LIZAFM(1,2) = RUX 287 : IMATRI.LIZAFM(1,3) = RUY 288 : IMATRI.LIZAFM(1,4) = RUZ 289 : IMATRI.LIZAFM(1,5) = RP 290 : C 291 : IMATRI.LIZAFM(1,6) = UXR 292 : IMATRI.LIZAFM(1,7) = UXUX 293 : IMATRI.LIZAFM(1,8) = UXUY 294 : IMATRI.LIZAFM(1,9) = UXUZ 295 : IMATRI.LIZAFM(1,10) = UXP 296 : C 297 : IMATRI.LIZAFM(1,11) = UYR 298 : IMATRI.LIZAFM(1,12) = UYUX 299 : IMATRI.LIZAFM(1,13) = UYUY 300 : IMATRI.LIZAFM(1,14) = UYUZ 301 : IMATRI.LIZAFM(1,15) = UYP 302 : C 303 : IMATRI.LIZAFM(1,16) = UZR 304 : IMATRI.LIZAFM(1,17) = UZUX 305 : IMATRI.LIZAFM(1,18) = UZUY 306 : IMATRI.LIZAFM(1,19) = UZUZ 307 : IMATRI.LIZAFM(1,20) = UZP 308 : C 309 : IMATRI.LIZAFM(1,21) = RETR 310 : IMATRI.LIZAFM(1,22) = RETUX 311 : IMATRI.LIZAFM(1,23) = RETUY 312 : IMATRI.LIZAFM(1,24) = RETUZ 313 : IMATRI.LIZAFM(1,25) = RETP 314 : C 315 : DO IFAC = 1, NFAC, 1 316 : NGCF = MELEFE.NUM(2,IFAC) 317 : NLCF = MLENTF.LECT(NGCF) 318 : IF(NLCF .NE. IFAC)THEN 319 : WRITE(IOIMP,*) 'Il ne faut pas jouer avec la table domaine' 319 : CALL ERREUR(5) 320 : GOTO 9999 321 : ENDIF 322 : NGCG = MELEFE.NUM(1,IFAC) 323 : NGCD = MELEFE.NUM(3,IFAC) 324 : NLFL = MLELIM.LECT(NGCF) 325 : IF(NLFL .NE. 0)THEN 326 : C 327 : C********** The point belongs on BC -> No contribution to jacobian! 328 : C 329 : MELEDU.NUM(1,IFAC) = NGCG 330 : MELEDU.NUM(2,IFAC) = NGCD 331 : ELSEIF(NGCG .NE. NGCD)THEN 332 : C 333 : C********** Les MELEMEs 334 : C 335 : MELEDU.NUM(1,IFAC) = NGCG 336 : MELEDU.NUM(2,IFAC) = NGCD 337 : C 338 : C********** Les etats G et D 339 : C 340 : NLCG = MLENTC.LECT(NGCG) 341 : NLCD = MLENTC.LECT(NGCD) 342 : C 343 : ROG = MPRN.VPOCHA(NLCG,1) 344 : PG = MPPN.VPOCHA(NLCG,1) 345 : UXG = MPUN.VPOCHA(NLCG,1) 346 : UYG = MPUN.VPOCHA(NLCG,2) 347 : UZG = MPUN.VPOCHA(NLCG,3) 348 : GAMG = MPGAMN.VPOCHA(NLCG,1) 349 : RETG= PG / (GAMG - 1.0D0) + 0.5D0 * ROG * 350 : & (UXG * UXG + UYG * UYG + UZG * UZG) 351 : VOLG = MPVOLU.VPOCHA(NLCG,1) 352 : C 353 : ROD = MPRN.VPOCHA(NLCD,1) 354 : PD = MPPN.VPOCHA(NLCD,1) 355 : UXD = MPUN.VPOCHA(NLCD,1) 356 : UYD = MPUN.VPOCHA(NLCD,2) 357 : UZD = MPUN.VPOCHA(NLCD,3) 358 : GAMD = MPGAMN.VPOCHA(NLCD,1) 359 : RETD= PD / (GAMD - 1.0D0) + 0.5D0 * ROD * 360 : & (UXD * UXD + UYD * UYD + UZD * UZD) 361 : VOLD = MPVOLU.VPOCHA(NLCD,1) 362 : C 363 : C********** La normale G->D 364 : C La tangente 365 : C 366 : SURF = MPOVSU.VPOCHA(NLCF,1) 367 : CNX = MPNORM.VPOCHA(NLCF,7) 368 : CNY = MPNORM.VPOCHA(NLCF,8) 369 : CNZ = MPNORM.VPOCHA(NLCF,9) 370 : C 371 : C********** Cosinus directeurs de tangente 1 372 : C 373 : CT1X = MPNORM.VPOCHA(NLCF,1) 374 : CT1Y = MPNORM.VPOCHA(NLCF,2) 375 : CT1Z = MPNORM.VPOCHA(NLCF,3) 376 : C 377 : C********** Cosinus directeurs de tangente 2 378 : C 379 : CT2X = MPNORM.VPOCHA(NLCF,4) 380 : CT2Y = MPNORM.VPOCHA(NLCF,5) 381 : CT2Z = MPNORM.VPOCHA(NLCF,6) 382 : C 383 : C********** La contribution de Gauche 384 : C 384 : CALL VLHJ5(ROG,UXG,UYG,UZG,PG,RETG,GAMG,CNX,CNY,CNZ, 385 : & CT1X,CT1Y,CT1Z,CT2X,CT2Y,CT2Z, 386 : & DFRO,DFRUN,DFRUT1,DFRUT2,DFRET) 387 : C 388 : C 389 : C********** AB.AM(IFAC,IPRIM,IDUAL) 390 : C A = nom de l'inconnu duale (Ro,rUX,rUY,RET) 391 : C B = nom de l'inconnu primale (Ro,rUX,rUY,RET) 392 : C IPRIM = 1, 2 -> G, D 393 : C IDUAL = 1, 2 -> G, D 394 : C i.e. 395 : C A_IDUAL = AB.AM(IFAC,IPRIM,IDUAL) * B_IPRIM + ... 396 : C 397 : C 398 : C********** Dual RN 399 : C 400 : FUNCEL = SURF * DFRO(1) 401 : RR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 402 : RR.AM(IFAC,1,2) = FUNCEL / VOLD 403 : C 404 : FUNCEL = SURF * DFRO(2) 405 : RUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 406 : RUX.AM(IFAC,1,2) = FUNCEL / VOLD 407 : C 408 : FUNCEL = SURF * DFRO(3) 409 : RUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 410 : RUY.AM(IFAC,1,2) = FUNCEL / VOLD 411 : C 412 : FUNCEL = SURF * DFRO(4) 413 : RUZ.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 414 : RUZ.AM(IFAC,1,2) = FUNCEL / VOLD 415 : C 416 : FUNCEL = SURF * DFRO(5) 417 : RP.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 418 : RP.AM(IFAC,1,2) = FUNCEL / VOLD 419 : C 420 : C********** Dual RUXN 421 : C 422 : FUNCEL = SURF * (DFRUN(1) * CNX + DFRUT1(1) * CT1X 423 : & + DFRUT2(1) * CT2X) 424 : UXR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 425 : UXR.AM(IFAC,1,2) = FUNCEL / VOLD 426 : C 427 : FUNCEL = SURF * (DFRUN(2) * CNX + DFRUT1(2) * CT1X 428 : & + DFRUT2(2) * CT2X) 429 : UXUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 430 : UXUX.AM(IFAC,1,2) = FUNCEL / VOLD 431 : C 432 : FUNCEL = SURF * (DFRUN(3) * CNX + DFRUT1(3) * CT1X 433 : & + DFRUT2(3) * CT2X) 434 : UXUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 435 : UXUY.AM(IFAC,1,2) = FUNCEL / VOLD 436 : C 437 : FUNCEL = SURF * (DFRUN(4) * CNX + DFRUT1(4) * CT1X 438 : & + DFRUT2(4) * CT2X) 439 : UXUZ.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 440 : UXUZ.AM(IFAC,1,2) = FUNCEL / VOLD 441 : C 442 : FUNCEL = SURF * (DFRUN(5) * CNX + DFRUT1(5) * CT1X 443 : & + DFRUT2(5) * CT2X) 444 : UXP.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 445 : UXP.AM(IFAC,1,2) = FUNCEL / VOLD 446 : C 447 : C********** Dual RUYN 448 : C 449 : FUNCEL = SURF * (DFRUN(1) * CNY + DFRUT1(1) * CT1Y 450 : & + DFRUT2(1) * CT2Y ) 451 : UYR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 452 : UYR.AM(IFAC,1,2) = FUNCEL / VOLD 453 : C 454 : FUNCEL = SURF * (DFRUN(2) * CNY + DFRUT1(2) * CT1Y 455 : & + DFRUT2(2) * CT2Y) 456 : UYUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 457 : UYUX.AM(IFAC,1,2) = FUNCEL / VOLD 458 : C 459 : FUNCEL = SURF * (DFRUN(3) * CNY + DFRUT1(3) * CT1Y 460 : & + DFRUT2(3) * CT2Y) 461 : UYUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 462 : UYUY.AM(IFAC,1,2) = FUNCEL / VOLD 463 : C 464 : FUNCEL = SURF * (DFRUN(4) * CNY + DFRUT1(4) * CT1Y 465 : & + DFRUT2(4) * CT2Y) 466 : UYUZ.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 467 : UYUZ.AM(IFAC,1,2) = FUNCEL / VOLD 468 : C 469 : FUNCEL = SURF * (DFRUN(5) * CNY + DFRUT1(5) * CT1Y 470 : & + DFRUT2(5) * CT2Y) 471 : UYP.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 472 : UYP.AM(IFAC,1,2) = FUNCEL / VOLD 473 : C 474 : C********** Dual RUZN 475 : C 476 : FUNCEL = SURF * (DFRUN(1) * CNZ + DFRUT1(1) * CT1Z 477 : & + DFRUT2(1) * CT2Z ) 478 : UZR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 479 : UZR.AM(IFAC,1,2) = FUNCEL / VOLD 480 : C 481 : FUNCEL = SURF * (DFRUN(2) * CNZ + DFRUT1(2) * CT1Z 482 : & + DFRUT2(2) * CT2Z) 483 : UZUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 484 : UZUX.AM(IFAC,1,2) = FUNCEL / VOLD 485 : C 486 : FUNCEL = SURF * (DFRUN(3) * CNZ + DFRUT1(3) * CT1Z 487 : & + DFRUT2(3) * CT2Z) 488 : UZUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 489 : UZUY.AM(IFAC,1,2) = FUNCEL / VOLD 490 : C 491 : FUNCEL = SURF * (DFRUN(4) * CNZ + DFRUT1(4) * CT1Z 492 : & + DFRUT2(4) * CT2Z) 493 : UZUZ.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 494 : UZUZ.AM(IFAC,1,2) = FUNCEL / VOLD 495 : C 496 : FUNCEL = SURF * (DFRUN(5) * CNZ + DFRUT1(5) * CT1Z 497 : & + DFRUT2(5) * CT2Z) 498 : UZP.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 499 : UZP.AM(IFAC,1,2) = FUNCEL / VOLD 500 : C 501 : C********** Dual RETN 502 : C 503 : FUNCEL = SURF * DFRET(1) 504 : RETR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 505 : RETR.AM(IFAC,1,2) = FUNCEL / VOLD 506 : C 507 : FUNCEL = SURF * DFRET(2) 508 : RETUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 509 : RETUX.AM(IFAC,1,2) = FUNCEL / VOLD 510 : C 511 : FUNCEL = SURF * DFRET(3) 512 : RETUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 513 : RETUY.AM(IFAC,1,2) = FUNCEL / VOLD 514 : C 515 : FUNCEL = SURF * DFRET(4) 516 : RETUZ.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 517 : RETUZ.AM(IFAC,1,2) = FUNCEL / VOLD 518 : C 519 : FUNCEL = SURF * DFRET(5) 520 : RETP.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 521 : RETP.AM(IFAC,1,2) = FUNCEL / VOLD 522 : C 523 : C 524 : C********** La contribution de D 525 : C 526 : CNX = -1.0D0 * CNX 527 : CNY = -1.0D0 * CNY 528 : CNZ = -1.0D0 * CNZ 529 : CT1X = -1.0D0 * CT1X 530 : CT1Y = -1.0D0 * CT1Y 531 : CT1Z = -1.0D0 * CT1Z 532 : CT2X = -1.0D0 * CT2X 533 : CT2Y = -1.0D0 * CT2Y 534 : CT2Z = -1.0D0 * CT2Z 535 : C 535 : CALL VLHJ5(ROD,UXD,UYD,UZD,PD,RETD,GAMD,CNX,CNY,CNZ, 536 : & CT1X,CT1Y,CT1Z,CT2X,CT2Y,CT2Z, 537 : & DFRO,DFRUN,DFRUT1,DFRUT2,DFRET) 538 : C 539 : C 540 : C********** Dual RN 541 : C 542 : FUNCEL = SURF * DFRO(1) 543 : RR.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD 544 : RR.AM(IFAC,2,1) = FUNCEL / VOLG 545 : C 546 : FUNCEL = SURF * DFRO(2) 547 : RUX.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD 548 : RUX.AM(IFAC,2,1) = FUNCEL / VOLG 549 : C 550 : FUNCEL = SURF * DFRO(3) 551 : RUY.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD 552 : RUY.AM(IFAC,2,1) = FUNCEL / VOLG 553 : C 554 : FUNCEL = SURF * DFRO(4) 555 : RUZ.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD 556 : RUZ.AM(IFAC,2,1) = FUNCEL / VOLG 557 : C 558 : FUNCEL = SURF * DFRO(5) 559 : RP.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD 560 : RP.AM(IFAC,2,1) = FUNCEL / VOLG 561 : C 562 : C********** Dual RUXN 563 : C 564 : FUNCEL = SURF * (DFRUN(1) * CNX + DFRUT1(1) * CT1X 565 : & + DFRUT2(1) * CT2X) 566 : UXR.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD 567 : UXR.AM(IFAC,2,1) = FUNCEL / VOLG 568 : C 569 : FUNCEL = SURF * (DFRUN(2) * CNX + DFRUT1(2) * CT1X 570 : & + DFRUT2(2) * CT2X) 571 : UXUX.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD 572 : UXUX.AM(IFAC,2,1) = FUNCEL / VOLG 573 : C 574 : FUNCEL = SURF * (DFRUN(3) * CNX + DFRUT1(3) * CT1X 575 : & + DFRUT2(3) * CT2X) 576 : UXUY.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD 577 : UXUY.AM(IFAC,2,1) = FUNCEL / VOLG 578 : C 579 : FUNCEL = SURF * (DFRUN(4) * CNX + DFRUT1(4) * CT1X 580 : & + DFRUT2(4) * CT2X) 581 : UXUZ.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD 582 : UXUZ.AM(IFAC,2,1) = FUNCEL / VOLG 583 : C 584 : FUNCEL = SURF * (DFRUN(5) * CNX + DFRUT1(5) * CT1X 585 : & + DFRUT2(5) * CT2X) 586 : UXP.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD 587 : UXP.AM(IFAC,2,1) = FUNCEL / VOLG 588 : C 589 : C********** Dual RUYN 590 : C 591 : FUNCEL = SURF * (DFRUN(1) * CNY + DFRUT1(1) * CT1Y 592 : & + DFRUT2(1) * CT2Y ) 593 : UYR.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD 594 : UYR.AM(IFAC,2,1) = FUNCEL / VOLG 595 : C 596 : FUNCEL = SURF * (DFRUN(2) * CNY + DFRUT1(2) * CT1Y 597 : & + DFRUT2(2) * CT2Y) 598 : UYUX.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD 599 : UYUX.AM(IFAC,2,1) = FUNCEL / VOLG 600 : C 601 : FUNCEL = SURF * (DFRUN(3) * CNY + DFRUT1(3) * CT1Y 602 : & + DFRUT2(3) * CT2Y) 603 : UYUY.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD 604 : UYUY.AM(IFAC,2,1) = FUNCEL / VOLG 605 : C 606 : FUNCEL = SURF * (DFRUN(4) * CNY + DFRUT1(4) * CT1Y 607 : & + DFRUT2(4) * CT2Y) 608 : UYUZ.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD 609 : UYUZ.AM(IFAC,2,1) = FUNCEL / VOLG 610 : C 611 : FUNCEL = SURF * (DFRUN(5) * CNY + DFRUT1(5) * CT1Y 612 : & + DFRUT2(5) * CT2Y) 613 : UYP.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD 614 : UYP.AM(IFAC,2,1) = FUNCEL / VOLG 615 : C 616 : C********** Dual RUZN 617 : C 618 : FUNCEL = SURF * (DFRUN(1) * CNZ + DFRUT1(1) * CT1Z 619 : & + DFRUT2(1) * CT2Z ) 620 : UZR.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD 621 : UZR.AM(IFAC,2,1) = FUNCEL / VOLG 622 : C 623 : FUNCEL = SURF * (DFRUN(2) * CNZ + DFRUT1(2) * CT1Z 624 : & + DFRUT2(2) * CT2Z) 625 : UZUX.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD 626 : UZUX.AM(IFAC,2,1) = FUNCEL / VOLG 627 : C 628 : FUNCEL = SURF * (DFRUN(3) * CNZ + DFRUT1(3) * CT1Z 629 : & + DFRUT2(3) * CT2Z) 630 : UZUY.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD 631 : UZUY.AM(IFAC,2,1) = FUNCEL / VOLG 632 : C 633 : FUNCEL = SURF * (DFRUN(4) * CNZ + DFRUT1(4) * CT1Z 634 : & + DFRUT2(4) * CT2Z) 635 : UZUZ.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD 636 : UZUZ.AM(IFAC,2,1) = FUNCEL / VOLG 637 : C 638 : FUNCEL = SURF * (DFRUN(5) * CNZ + DFRUT1(5) * CT1Z 639 : & + DFRUT2(5) * CT2Z) 640 : UZP.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD 641 : UZP.AM(IFAC,2,1) = FUNCEL / VOLG 642 : C 643 : C********** Dual RETN 644 : C 645 : FUNCEL = SURF * DFRET(1) 646 : RETR.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD 647 : RETR.AM(IFAC,2,1) = FUNCEL / VOLG 648 : C 649 : FUNCEL = SURF * DFRET(2) 650 : RETUX.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD 651 : RETUX.AM(IFAC,2,1) = FUNCEL / VOLG 652 : C 653 : FUNCEL = SURF * DFRET(3) 654 : RETUY.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD 655 : RETUY.AM(IFAC,2,1) = FUNCEL / VOLG 656 : C 657 : FUNCEL = SURF * DFRET(4) 658 : RETUZ.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD 659 : RETUZ.AM(IFAC,2,1) = FUNCEL / VOLG 660 : C 661 : FUNCEL = SURF * DFRET(5) 662 : RETP.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD 663 : RETP.AM(IFAC,2,1) = FUNCEL / VOLG 664 : C 665 : ELSE 666 : C 667 : C********** Murs (NGCG = NGCD) 668 : C 669 : C 670 : C********** Les MELEMEs 671 : C 672 : MELEDU.NUM(1,IFAC) = NGCG 673 : MELEDU.NUM(2,IFAC) = NGCD 674 : NLCG = MLENTC.LECT(NGCG) 675 : C 676 : ROG = MPRN.VPOCHA(NLCG,1) 677 : PG = MPPN.VPOCHA(NLCG,1) 678 : UXG = MPUN.VPOCHA(NLCG,1) 679 : UYG = MPUN.VPOCHA(NLCG,2) 680 : UZG = MPUN.VPOCHA(NLCG,3) 681 : GAMG = MPGAMN.VPOCHA(NLCG,1) 682 : VOLG = MPVOLU.VPOCHA(NLCG,1) 683 : C 684 : C********** La normale sortante 685 : C 686 : SURF = MPOVSU.VPOCHA(NLCF,1) 687 : CNX = MPNORM.VPOCHA(NLCF,7) 688 : CNY = MPNORM.VPOCHA(NLCF,8) 689 : CNZ = MPNORM.VPOCHA(NLCF,9) 690 : C 690 : CALL VLHJ7(ROG,UXG,UYG,UZG,PG,GAMG,CNX,CNY,CNZ, 691 : & DFRUN) 692 : C 693 : C********** Dual RN 694 : C 695 : RR.AM(IFAC,1,1) = 0.0D0 696 : RR.AM(IFAC,1,2) = 0.0D0 697 : C 698 : RUX.AM(IFAC,1,1) = 0.0D0 699 : RUX.AM(IFAC,1,2) = 0.0D0 700 : C 701 : RUY.AM(IFAC,1,1) = 0.0D0 702 : RUY.AM(IFAC,1,2) = 0.0D0 703 : C 704 : RUZ.AM(IFAC,1,1) = 0.0D0 705 : RUZ.AM(IFAC,1,2) = 0.0D0 706 : C 707 : RP.AM(IFAC,1,1) = 0.0D0 708 : RP.AM(IFAC,1,2) = 0.0D0 709 : C 710 : C********** Dual RUXN 711 : C 712 : FUNCEL = SURF * DFRUN(1) * CNX 713 : UXR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 714 : UXR.AM(IFAC,1,2) = 0.0D0 715 : C 716 : FUNCEL = SURF * DFRUN(2) * CNX 717 : UXUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 718 : UXUX.AM(IFAC,1,2) = 0.0D0 719 : C 720 : FUNCEL = SURF * DFRUN(3) * CNX 721 : UXUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 722 : UXUY.AM(IFAC,1,2) = 0.0D0 723 : C 724 : FUNCEL = SURF * DFRUN(4) * CNX 725 : UXUZ.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 726 : UXUZ.AM(IFAC,1,2) = 0.0D0 727 : C 728 : FUNCEL = SURF * DFRUN(5) * CNX 729 : UXP.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 730 : UXP.AM(IFAC,1,2) = 0.0D0 731 : C 732 : C********** Dual RUYN 733 : C 734 : FUNCEL = SURF * DFRUN(1) * CNY 735 : UYR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 736 : UYR.AM(IFAC,1,2) = 0.0D0 737 : C 738 : FUNCEL = SURF * DFRUN(2) * CNY 739 : UYUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 740 : UYUX.AM(IFAC,1,2) = 0.0D0 741 : C 742 : FUNCEL = SURF * DFRUN(3) * CNY 743 : UYUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 744 : UYUY.AM(IFAC,1,2) = 0.0D0 745 : C 746 : FUNCEL = SURF * DFRUN(4) * CNY 747 : UYUZ.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 748 : UYUZ.AM(IFAC,1,2) = 0.0D0 749 : C 750 : FUNCEL = SURF * DFRUN(5) * CNY 751 : UYP.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 752 : UYP.AM(IFAC,1,2) = 0.0D0 753 : C 754 : C********** Dual RUZN 755 : C 756 : FUNCEL = SURF * DFRUN(1) * CNZ 757 : UZR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 758 : UZR.AM(IFAC,1,2) = 0.0D0 759 : C 760 : FUNCEL = SURF * DFRUN(2) * CNZ 761 : UZUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 762 : UZUX.AM(IFAC,1,2) = 0.0D0 763 : C 764 : FUNCEL = SURF * DFRUN(3) * CNZ 765 : UZUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 766 : UZUY.AM(IFAC,1,2) = 0.0D0 767 : C 768 : FUNCEL = SURF * DFRUN(4) * CNZ 769 : UZUZ.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 770 : UZUZ.AM(IFAC,1,2) = 0.0D0 771 : C 772 : FUNCEL = SURF * DFRUN(5) * CNZ 773 : UZP.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG 774 : UZP.AM(IFAC,1,2) = 0.0D0 775 : C 776 : C********** Dual RETN 777 : C 778 : RETR.AM(IFAC,1,1) = 0.0D0 779 : RETR.AM(IFAC,1,2) = 0.0D0 780 : C 781 : RETUX.AM(IFAC,1,1) = 0.0D0 782 : RETUX.AM(IFAC,1,2) = 0.0D0 783 : C 784 : RETUY.AM(IFAC,1,1) = 0.0D0 785 : RETUY.AM(IFAC,1,2) = 0.0D0 786 : C 787 : RETUZ.AM(IFAC,1,1) = 0.0D0 788 : RETUZ.AM(IFAC,1,2) = 0.0D0 789 : C 790 : RETP.AM(IFAC,1,1) = 0.0D0 791 : RETP.AM(IFAC,1,2) = 0.0D0 792 : C 793 : C********** Dual RN 794 : C 795 : RR.AM(IFAC,2,2) = 0.0D0 796 : RR.AM(IFAC,2,1) = 0.0D0 797 : C 798 : RUX.AM(IFAC,2,2) = 0.0D0 799 : RUX.AM(IFAC,2,1) = 0.0D0 800 : C 801 : RUY.AM(IFAC,2,2) = 0.0D0 802 : RUY.AM(IFAC,2,1) = 0.0D0 803 : C 804 : RUZ.AM(IFAC,2,2) = 0.0D0 805 : RUZ.AM(IFAC,2,1) = 0.0D0 806 : C 807 : RP.AM(IFAC,2,2) = 0.0D0 808 : RP.AM(IFAC,2,1) = 0.0D0 809 : C 810 : C********** Dual RUXN 811 : C 812 : UXR.AM(IFAC,2,2) = 0.0D0 813 : UXR.AM(IFAC,2,1) = 0.0D0 814 : C 815 : UXUX.AM(IFAC,2,2) = 0.0D0 816 : UXUX.AM(IFAC,2,1) = 0.0D0 817 : C 818 : UXUY.AM(IFAC,2,2) = 0.0D0 819 : UXUY.AM(IFAC,2,1) = 0.0D0 820 : C 821 : UXUZ.AM(IFAC,2,2) = 0.0D0 822 : UXUZ.AM(IFAC,2,1) = 0.0D0 823 : C 824 : UXP.AM(IFAC,2,2) = 0.0D0 825 : UXP.AM(IFAC,2,1) = 0.0D0 826 : C 827 : C********** Dual RUYN 828 : C 829 : UYR.AM(IFAC,2,2) = 0.0D0 830 : UYR.AM(IFAC,2,1) = 0.0D0 831 : C 832 : UYUX.AM(IFAC,2,2) = 0.0D0 833 : UYUX.AM(IFAC,2,1) = 0.0D0 834 : C 835 : UYUY.AM(IFAC,2,2) = 0.0D0 836 : UYUY.AM(IFAC,2,1) = 0.0D0 837 : C 838 : UYUZ.AM(IFAC,2,2) = 0.0D0 839 : UYUZ.AM(IFAC,2,1) = 0.0D0 840 : C 841 : UYP.AM(IFAC,2,2) = 0.0D0 842 : UYP.AM(IFAC,2,1) = 0.0D0 843 : C 844 : C********** Dual RUZN 845 : C 846 : UZR.AM(IFAC,2,2) = 0.0D0 847 : UZR.AM(IFAC,2,1) = 0.0D0 848 : C 849 : UZUX.AM(IFAC,2,2) = 0.0D0 850 : UZUX.AM(IFAC,2,1) = 0.0D0 851 : C 852 : UZUY.AM(IFAC,2,2) = 0.0D0 853 : UZUY.AM(IFAC,2,1) = 0.0D0 854 : C 855 : UZUZ.AM(IFAC,2,2) = 0.0D0 856 : UZUZ.AM(IFAC,2,1) = 0.0D0 857 : C 858 : UZP.AM(IFAC,2,2) = 0.0D0 859 : UZP.AM(IFAC,2,1) = 0.0D0 860 : C 861 : C********** Dual RETN 862 : C 863 : RETR.AM(IFAC,2,2) = 0.0D0 864 : RETR.AM(IFAC,2,1) = 0.0D0 865 : C 866 : RETUX.AM(IFAC,2,2) = 0.0D0 867 : RETUX.AM(IFAC,2,1) = 0.0D0 868 : C 869 : RETUY.AM(IFAC,2,2) = 0.0D0 870 : RETUY.AM(IFAC,2,1) = 0.0D0 871 : C 872 : RETUZ.AM(IFAC,2,2) = 0.0D0 873 : RETUZ.AM(IFAC,2,1) = 0.0D0 874 : C 875 : RETP.AM(IFAC,2,2) = 0.0D0 876 : RETP.AM(IFAC,2,1) = 0.0D0 877 : C 878 : ENDIF 879 : ENDDO 880 : C 881 : SEGDES MELEMC 882 : SEGDES MELEFE 883 : SEGDES MELEMF 884 : C 885 : SEGDES MPOVSU 886 : SEGDES MPVOLU 887 : SEGDES MPNORM 888 : C 889 : SEGDES MPRN 890 : SEGDES MPPN 891 : SEGDES MPUN 892 : SEGDES MPGAMN 893 : C 894 : SEGDES MELEDU 895 : SEGDES MATRIK 896 : SEGDES IMATRI 897 : C 898 : SEGDES RR , RUX , RUY , RUZ, RP , 899 : & UXR , UXUX , UXUY , UXUZ, UXP , 900 : & UYR , UYUX , UYUY , UYUZ, UYP , 901 : & UZR , UZUX , UZUY , UZUZ, UYP , 902 : & RETR , RETUX , RETUY , RETUZ, RETP 903 : 904 : SEGSUP MLENTC 905 : SEGSUP MLENTF 906 : SEGDES MLMINC 907 : SEGSUP MLELIM 908 : 909 : 9999 CONTINUE 910 : RETURN 911 : END 912 : 913 : 914 : 915 : 916 : 917 : 918 :
© Cast3M 2003 - All rights reserved.
Disclaimer