1 : C CLI173 SOURCE MAGN 09/07/30 21:15:59 6458 2 : SUBROUTINE CLI173(MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM,ICHPVO, 3 : & ICHPSU,IROC,IVITC,IPC,IGAMC,ICHLIM,ILIINC,ILIINP,IJAC,IJACO) 4 : C************************************************************************ 5 : C 6 : C PROJET : CASTEM 2000 7 : C 8 : C NOM : CLI173 9 : C 10 : C DESCRIPTION : Subroutine appellée par CLIM11 11 : C 12 : C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI) 13 : C 14 : C AUTEUR : A. BECCANTINI, DRN/DMT/SEMT/LTMF 15 : C 16 : C************************************************************************ 17 : C 18 : C APPELES (Calcul) : 19 : C 20 : C************************************************************************ 21 : C 22 : C HISTORIQUE (Anomalies et modifications éventuelles) 23 : C 24 : C HISTORIQUE : 25 : C 26 : C************************************************************************ 27 : C 28 : IMPLICIT INTEGER(I-N) 29 : -INC CCOPTIO 30 : -INC SMLMOTS 31 : -INC SMELEME 32 : POINTEUR MELEFC.MELEME 33 : -INC SMLENTI 34 : POINTEUR MLEMC.MLENTI, MLEMCB.MLENTI,MLEMF.MLENTI 35 : -INC SMCHPOI 36 : POINTEUR MPNORM.MPOVAL, MPVOL.MPOVAL, MPSURF.MPOVAL, MPRC.MPOVAL, 37 : & MPVC.MPOVAL, MPPC.MPOVAL, MPGAMC.MPOVAL, MPLIM.MPOVAL 38 : -INC SMMATRIK 39 : POINTEUR RR.IZAFM, RUX.IZAFM, RUY.IZAFM, RRET.IZAFM, 40 : & UXR.IZAFM, UXUX.IZAFM, UXUY.IZAFM, UXRET.IZAFM, 41 : & UYR.IZAFM, UYUX.IZAFM, UYUY.IZAFM, UYRET.IZAFM, 42 : & RETR.IZAFM, RETUX.IZAFM, RETUY.IZAFM, RETRET.IZAFM, 43 : & RUZ.IZAFM, UXUZ.IZAFM, UYUZ.IZAFM, RETUZ.IZAFM, 44 : & UZR.IZAFM, UZUX.IZAFM, UZUY.IZAFM, UZRET.IZAFM, 45 : & UZUZ.IZAFM 46 : C 47 : C**** Variables de COOPTIO 48 : C 49 : C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR 50 : C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ 51 : C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES 52 : C & ,IECHO, IIMPI, IOSPI 53 : C & ,IDIM, IFICLE, IPREFI 54 : C & ,MCOORD 55 : C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE 56 : C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU 57 : C & ,NORINC,NORVAL,NORIND,NORVAD 58 : C & ,NUCROU, IPSAUV 59 : C 60 : INTEGER MELEMF,MELEMC,MELECB,INORM,ICHPVO,ICHPSU, IROC,IVITC,IPC 61 : & ,IGAMC,ICHLIM,ICEL,NFAC,IFAC,MELRES,IJACO 62 : & ,NGF,NGC,NLF,NLC,NLCB 63 : & ,ILIINC,ILIINP,IJAC 64 : & ,MP, NBEL, NBME, NBSOUS, NKID, NKMT, NMATRI, NP, NRIGE 65 : REAL*8 VOLU,SURF,GAMC,CNX,CNY,CNZ,GM1 66 : & ,RC,UXC,UYC,UZC 67 : & ,PC,PSRF,RHOUF,P,RHO,UN 68 : & ,DECIDP,DUNDPC,DUXDPC,DUYDPC,DUZDPC 69 : & ,DRORO,DROUX,DROUY,DROP 70 : & ,DUXRO,DUXUX,DUXUY,DUXP 71 : & ,DUYRO,DUYUX,DUYUY,DUYP 72 : & ,DPRO,DPUX,DPUY,DPP 73 : & ,COEF1,COEF2,COEF3,COEF,COEF4 74 : & ,DROUZ,DUXUZ,DUYUZ,DPUZ 75 : & ,DUZRO,DUZUX,DUZUY,DUZUZ,DUZP 76 : CHARACTER*(8) TYPE 77 : C 78 : C 79 : C**** KRIPAD pour la correspondance global/local 80 : C 80 : CALL KRIPAD(MELEMC,MLEMC) 81 : C SEGINI MLEMC 81 : CALL KRIPAD(MELECB,MLEMCB) 82 : C SEGINI MLEMCB 82 : CALL KRIPAD(MELEMF,MLEMF) 83 : C SEGINI MLEMF 84 : C 85 : C**** CHPOINTs de la table DOMAINE 86 : C 86 : CALL LICHT(INORM,MPNORM,TYPE,ICEL) 86 : CALL LICHT(ICHPVO,MPVOL,TYPE,ICEL) 86 : CALL LICHT(ICHPSU,MPSURF,TYPE,ICEL) 87 : C 88 : C**** LICHT active les MPOVALs en *MOD 89 : C 90 : C SEGACT MPNORM*MOD 91 : C SEGACT MPOVSU*MOD 92 : C SEGACT MPOVOL*MOD 93 : C 94 : C 95 : C**** CHPOINTs des variables 96 : C 96 : CALL LICHT(IROC,MPRC,TYPE,ICEL) 96 : CALL LICHT(IVITC,MPVC,TYPE,ICEL) 96 : CALL LICHT(IPC,MPPC,TYPE,ICEL) 96 : CALL LICHT(IGAMC,MPGAMC,TYPE,ICEL) 96 : CALL LICHT(ICHLIM,MPLIM,TYPE,ICEL) 97 : C 98 : C SEGACT *MOD 99 : C SEGACT *MOD 100 : C SEGACT *MOD 101 : C SEGACT *MOD 102 : C SEGACT *MOD 103 : C 104 : C 105 : C**** Boucle sur le face pour le calcul des invariants de 106 : C Riemann et du flux 107 : C 108 : SEGACT MELEFC 109 : NFAC=MELEFC.NUM(/2) 110 : C 111 : C**** Objet MATRIK 112 : C 113 : NRIGE = 7 114 : NMATRI = 1 115 : NKID = 9 116 : NKMT = 7 117 : C 118 : SEGINI MATRIK 119 : IJACO = MATRIK 120 : MATRIK.IRIGEL(1,1) = MELRES 121 : MATRIK.IRIGEL(2,1) = MELRES 122 : C 123 : C**** Matrice non symetrique 124 : C 125 : MATRIK.IRIGEL(7,1) = 2 126 : C 127 : NBME = 25 128 : NBSOUS = 1 129 : SEGINI IMATRI 130 : IF(IJAC.EQ.1)THEN 131 : MLMOTS=ILIINC 132 : ELSEIF(IJAC.EQ.2)THEN 133 : MLMOTS=ILIINP 134 : ENDIF 135 : SEGACT MLMOTS 136 : MATRIK.IRIGEL(4,1) = IMATRI 137 : C 138 : IMATRI.LISPRI(1) = MLMOTS.MOTS(1) 139 : IMATRI.LISPRI(2) = MLMOTS.MOTS(2) 140 : IMATRI.LISPRI(3) = MLMOTS.MOTS(3) 141 : IMATRI.LISPRI(4) = MLMOTS.MOTS(4) 142 : IMATRI.LISPRI(5) = MLMOTS.MOTS(5) 143 : C 144 : IMATRI.LISPRI(6) = MLMOTS.MOTS(1) 145 : IMATRI.LISPRI(7) = MLMOTS.MOTS(2) 146 : IMATRI.LISPRI(8) = MLMOTS.MOTS(3) 147 : IMATRI.LISPRI(9) = MLMOTS.MOTS(4) 148 : IMATRI.LISPRI(10) = MLMOTS.MOTS(5) 149 : C 150 : IMATRI.LISPRI(11) = MLMOTS.MOTS(1) 151 : IMATRI.LISPRI(12) = MLMOTS.MOTS(2) 152 : IMATRI.LISPRI(13) = MLMOTS.MOTS(3) 153 : IMATRI.LISPRI(14) = MLMOTS.MOTS(4) 154 : IMATRI.LISPRI(15) = MLMOTS.MOTS(5) 155 : C 156 : IMATRI.LISPRI(16) = MLMOTS.MOTS(1) 157 : IMATRI.LISPRI(17) = MLMOTS.MOTS(2) 158 : IMATRI.LISPRI(18) = MLMOTS.MOTS(3) 159 : IMATRI.LISPRI(19) = MLMOTS.MOTS(4) 160 : IMATRI.LISPRI(20) = MLMOTS.MOTS(5) 161 : C 162 : IMATRI.LISPRI(21) = MLMOTS.MOTS(1) 163 : IMATRI.LISPRI(22) = MLMOTS.MOTS(2) 164 : IMATRI.LISPRI(23) = MLMOTS.MOTS(3) 165 : IMATRI.LISPRI(24) = MLMOTS.MOTS(4) 166 : IMATRI.LISPRI(25) = MLMOTS.MOTS(5) 167 : C 168 : SEGDES MLMOTS 169 : MLMOTS=ILIINC 170 : SEGACT MLMOTS 171 : C 172 : C 173 : IMATRI.LISDUA(1) = MLMOTS.MOTS(1) 174 : IMATRI.LISDUA(2) = MLMOTS.MOTS(1) 175 : IMATRI.LISDUA(3) = MLMOTS.MOTS(1) 176 : IMATRI.LISDUA(4) = MLMOTS.MOTS(1) 177 : IMATRI.LISDUA(5) = MLMOTS.MOTS(1) 178 : C 179 : IMATRI.LISDUA(6) = MLMOTS.MOTS(2) 180 : IMATRI.LISDUA(7) = MLMOTS.MOTS(2) 181 : IMATRI.LISDUA(8) = MLMOTS.MOTS(2) 182 : IMATRI.LISDUA(9) = MLMOTS.MOTS(2) 183 : IMATRI.LISDUA(10) = MLMOTS.MOTS(2) 184 : C 185 : IMATRI.LISDUA(11) = MLMOTS.MOTS(3) 186 : IMATRI.LISDUA(12) = MLMOTS.MOTS(3) 187 : IMATRI.LISDUA(13) = MLMOTS.MOTS(3) 188 : IMATRI.LISDUA(14) = MLMOTS.MOTS(3) 189 : IMATRI.LISDUA(15) = MLMOTS.MOTS(3) 190 : C 191 : IMATRI.LISDUA(16) = MLMOTS.MOTS(4) 192 : IMATRI.LISDUA(17) = MLMOTS.MOTS(4) 193 : IMATRI.LISDUA(18) = MLMOTS.MOTS(4) 194 : IMATRI.LISDUA(19) = MLMOTS.MOTS(4) 195 : IMATRI.LISDUA(20) = MLMOTS.MOTS(4) 196 : C 197 : IMATRI.LISDUA(21) = MLMOTS.MOTS(5) 198 : IMATRI.LISDUA(22) = MLMOTS.MOTS(5) 199 : IMATRI.LISDUA(23) = MLMOTS.MOTS(5) 200 : IMATRI.LISDUA(24) = MLMOTS.MOTS(5) 201 : IMATRI.LISDUA(25) = MLMOTS.MOTS(5) 202 : C 203 : SEGDES MLMOTS 204 : NBEL = NFAC 205 : NBSOUS = 1 206 : NP = 1 207 : MP = 1 208 : SEGINI RR , RUX , RUY , RUZ ,RRET , 209 : & UXR , UXUX , UXUY , UXUZ ,UXRET , 210 : & UYR , UYUX , UYUY , UYUZ , UYRET , 211 : & UZR , UZUX , UZUY , UZUZ , UZRET , 212 : & RETR , RETUX , RETUY, RETUZ , RETRET 213 : C 214 : C**** Duale = IMATRI.LISDUA(1) = 'RN' 215 : C Primale = IMATRI.LISPRI(1) = 'RN' 216 : C -> IMATRI.LIZAFM(1,1) = RR 217 : C 218 : IMATRI.LIZAFM(1,1) = RR 219 : IMATRI.LIZAFM(1,2) = RUX 220 : IMATRI.LIZAFM(1,3) = RUY 221 : IMATRI.LIZAFM(1,4) = RUZ 222 : IMATRI.LIZAFM(1,5) = RRET 223 : C 224 : IMATRI.LIZAFM(1,6) = UXR 225 : IMATRI.LIZAFM(1,7) = UXUX 226 : IMATRI.LIZAFM(1,8) = UXUY 227 : IMATRI.LIZAFM(1,9) = UXUZ 228 : IMATRI.LIZAFM(1,10) = UXRET 229 : C 230 : IMATRI.LIZAFM(1,11) = UYR 231 : IMATRI.LIZAFM(1,12) = UYUX 232 : IMATRI.LIZAFM(1,13) = UYUY 233 : IMATRI.LIZAFM(1,14) = UYUZ 234 : IMATRI.LIZAFM(1,15) = UYRET 235 : C 236 : IMATRI.LIZAFM(1,16) = UZR 237 : IMATRI.LIZAFM(1,17) = UZUX 238 : IMATRI.LIZAFM(1,18) = UZUY 239 : IMATRI.LIZAFM(1,19) = UZUZ 240 : IMATRI.LIZAFM(1,20) = UZRET 241 : C 242 : IMATRI.LIZAFM(1,21) = RETR 243 : IMATRI.LIZAFM(1,22) = RETUX 244 : IMATRI.LIZAFM(1,23) = RETUY 245 : IMATRI.LIZAFM(1,24) = RETUZ 246 : IMATRI.LIZAFM(1,25) = RETRET 247 : C 248 : SEGDES MATRIK 249 : SEGDES IMATRI 250 : C 251 : C**** Fin definition MATRIK 252 : C 253 : DO IFAC=1,NFAC,1 254 : NGF=MELEFC.NUM(1,IFAC) 255 : NGC=MELEFC.NUM(2,IFAC) 256 : NLF=MLEMF.LECT(NGF) 257 : NLC=MLEMC.LECT(NGC) 258 : NLCB=MLEMCB.LECT(NGF) 259 : VOLU=MPVOL.VPOCHA(NLC,1) 260 : SURF=MPSURF.VPOCHA(NLF,1) 261 : C In CASTEM les normales sont sortantes 262 : CNX=-1*MPNORM.VPOCHA(NLF,1) 263 : CNY=-1*MPNORM.VPOCHA(NLF,2) 264 : CNZ=-1*MPNORM.VPOCHA(NLF,3) 265 : C Variables au centre 266 : RC=MPRC.VPOCHA(NLC,1) 267 : PC=MPPC.VPOCHA(NLC,1) 268 : UXC=MPVC.VPOCHA(NLC,1) 269 : UYC=MPVC.VPOCHA(NLC,2) 270 : UZC=MPVC.VPOCHA(NLC,3) 271 : GAMC=MPGAMC.VPOCHA(NLC,1) 272 : GM1=GAMC-1.0D0 273 : RHOUF=MPLIM.VPOCHA(NLCB,1) 274 : PSRF=MPLIM.VPOCHA(NLCB,2) 275 : C 276 : C******* Variables à l'interface 277 : C 278 : P=PC 279 : RHO=P/PSRF 280 : UN=RHOUF/RHO 281 : C 282 : C******* Derivative with respect to PC 283 : C 284 : DUNDPC=-1*RHOUF/(RHO*RHO*PSRF) 285 : DUXDPC=CNX*DUNDPC 286 : DUYDPC=CNY*DUNDPC 287 : DUZDPC=CNZ*DUNDPC 288 : DECIDP=UN*DUNDPC 289 : C 290 : C******* Jacobian with respect to primitive variables 291 : C 292 : COEF=SURF/VOLU 293 : DRORO=0.0D0 294 : DROUX=0.0D0 295 : DROUY=0.0D0 296 : DROUZ=0.0D0 297 : DROP=0.0D0 298 : C 299 : DPRO=0.0D0 300 : DPUX=0.0D0 301 : DPUY=0.0D0 302 : DPUZ=0.0D0 303 : DPP=(RHOUF*DECIDP)*COEF 304 : C 305 : DUXRO=0.0D0 306 : DUXUX=0.0D0 307 : DUXUY=0.0D0 308 : DUXUZ=0.0D0 309 : DUXP =(RHOUF*DUXDPC+CNX)*COEF 310 : C 311 : DUYRO=0.0D0 312 : DUYUX=0.0D0 313 : DUYUY=0.0D0 314 : DUYUZ=0.0D0 315 : DUYP =(RHOUF*DUYDPC+CNY)*COEF 316 : C 317 : DUZRO=0.0D0 318 : DUZUX=0.0D0 319 : DUZUY=0.0D0 320 : DUZUZ=0.0D0 321 : DUZP =(RHOUF*DUZDPC+CNZ)*COEF 322 : C 323 : C******* Jacobian with respect to conservative variables 324 : C 325 : IF(IJAC.EQ.1)THEN 326 : GM1=GAMC-1.0D0 327 : C 328 : COEF1=-1.0D0*UXC/RC 329 : COEF2=-1.0D0*UYC/RC 330 : COEF3=-1.0D0*UZC/RC 331 : COEF4=0.5D0*GM1*((UXC*UXC)+(UYC*UYC)+(UZC*UZC)) 332 : C 333 : RR.AM(IFAC,1,1)=DRORO+(DROUX*COEF1)+(DROUY*COEF2)+(DROUZ 334 : $ *COEF3)+(DROP*COEF4) 335 : RUX.AM(IFAC,1,1)=(DROUX/RC)-((UXC*GM1)*DROP) 336 : RUY.AM(IFAC,1,1)=(DROUY/RC)-((UYC*GM1)*DROP) 337 : RUZ.AM(IFAC,1,1)=(DROUZ/RC)-((UZC*GM1)*DROP) 338 : RRET.AM(IFAC,1,1)=GM1*DROP 339 : C 340 : UXR.AM(IFAC,1,1)=DUXRO+(DUXUX*COEF1)+(DUXUY*COEF2)+(DUXUZ 341 : $ *COEF3)+(DUXP*COEF4) 342 : UXUX.AM(IFAC,1,1)=(DUXUX/RC)-((UXC*GM1)*DUXP) 343 : UXUY.AM(IFAC,1,1)=(DUXUY/RC)-((UYC*GM1)*DUXP) 344 : UXUZ.AM(IFAC,1,1)=(DUXUZ/RC)-((UZC*GM1)*DUXP) 345 : UXRET.AM(IFAC,1,1)=GM1*DUXP 346 : C 347 : UYR.AM(IFAC,1,1)=DUYRO+(DUYUX*COEF1)+(DUYUY*COEF2)+(DUYUZ 348 : $ *COEF3)+(DUYP*COEF4) 349 : UYUX.AM(IFAC,1,1)=(DUYUX/RC)-((UXC*GM1)*DUYP) 350 : UYUY.AM(IFAC,1,1)=(DUYUY/RC)-((UYC*GM1)*DUYP) 351 : UYUZ.AM(IFAC,1,1)=(DUYUZ/RC)-((UZC*GM1)*DUYP) 352 : UYRET.AM(IFAC,1,1)=GM1*DUYP 353 : C 354 : UZR.AM(IFAC,1,1)=DUZRO+(DUZUX*COEF1)+(DUZUY*COEF2)+(DUZUZ 355 : $ *COEF3)+(DUZP*COEF4) 356 : UZUX.AM(IFAC,1,1)=(DUZUX/RC)-((UXC*GM1)*DUZP) 357 : UZUY.AM(IFAC,1,1)=(DUZUY/RC)-((UYC*GM1)*DUZP) 358 : UZUZ.AM(IFAC,1,1)=(DUZUZ/RC)-((UZC*GM1)*DUZP) 359 : UZRET.AM(IFAC,1,1)=GM1*DUZP 360 : C 361 : RETR.AM(IFAC,1,1)=DPRO+(DPUX*COEF1)+(DPUY*COEF2)+(DPUZ 362 : $ *COEF3)+(DPP*COEF4) 363 : RETUX.AM(IFAC,1,1)=(DPUX/RC)-((UXC*GM1)*DPP) 364 : RETUY.AM(IFAC,1,1)=(DPUY/RC)-((UYC*GM1)*DPP) 365 : RETUZ.AM(IFAC,1,1)=(DPUZ/RC)-((UZC*GM1)*DPP) 366 : RETRET.AM(IFAC,1,1)=GM1*DPP 367 : C 368 : ELSEIF(IJAC.EQ.2)THEN 369 : RR.AM(IFAC,1,1)=DRORO 370 : RUX.AM(IFAC,1,1)=DROUX 371 : RUY.AM(IFAC,1,1)=DROUY 372 : RUZ.AM(IFAC,1,1)=DROUZ 373 : RRET.AM(IFAC,1,1)=DROP 374 : C 375 : UXR.AM(IFAC,1,1)=DUXRO 376 : UXUX.AM(IFAC,1,1)=DUXUX 377 : UXUY.AM(IFAC,1,1)=DUXUY 378 : UXUZ.AM(IFAC,1,1)=DUXUZ 379 : UXRET.AM(IFAC,1,1)=DUXP 380 : C 381 : UYR.AM(IFAC,1,1)=DUYRO 382 : UYUX.AM(IFAC,1,1)=DUYUX 383 : UYUY.AM(IFAC,1,1)=DUYUY 384 : UYUZ.AM(IFAC,1,1)=DUYUZ 385 : UYRET.AM(IFAC,1,1)=DUYP 386 : C 387 : UZR.AM(IFAC,1,1)=DUZRO 388 : UZUX.AM(IFAC,1,1)=DUZUX 389 : UZUY.AM(IFAC,1,1)=DUZUY 390 : UZUZ.AM(IFAC,1,1)=DUZUZ 391 : UZRET.AM(IFAC,1,1)=DUZP 392 : C 393 : RETR.AM(IFAC,1,1)=DPRO 394 : RETUX.AM(IFAC,1,1)=DPUX 395 : RETUY.AM(IFAC,1,1)=DPUY 396 : RETUZ.AM(IFAC,1,1)=DPUZ 397 : RETRET.AM(IFAC,1,1)=DPP 398 : ENDIF 399 : ENDDO 400 : C 401 : SEGDES MELEFC 402 : C 403 : SEGSUP MLEMC 404 : SEGSUP MLEMCB 405 : SEGSUP MLEMF 406 : C 407 : SEGDES MPNORM 408 : SEGDES MPVOL 409 : SEGDES MPSURF 410 : SEGDES MPRC 411 : SEGDES MPPC 412 : SEGDES MPVC 413 : SEGDES MPGAMC 414 : SEGDES MPLIM 415 : C 416 : SEGDES RR , RUX , RUY , RUZ ,RRET , 417 : & UXR , UXUX , UXUY , UXUZ ,UXRET , 418 : & UYR , UYUX , UYUY , UYUZ , UYRET , 419 : & UZR , UZUX , UZUY , UZUZ , UZRET , 420 : & RETR , RETUX , RETUY, RETUZ , RETRET 421 : C 422 : 9999 CONTINUE 423 : RETURN 424 : END 425 : 426 : 427 : 428 : 429 : 430 : 431 : 432 : 433 :
© Cast3M 2003 - All rights reserved.
Disclaimer