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