1 : C CLI143 SOURCE MAGN 09/07/30 21:15:45 6458 2 : SUBROUTINE CLI143(MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM,ICHPVO, 3 : & ICHPSU,IROC,IVITC,IPC,IGAMC,ILIINC,ILIINP,IJAC,IJACO) 4 : C************************************************************************ 5 : C 6 : C PROJET : CASTEM 2000 7 : C 8 : C NOM : CLI143 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 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,ICEL,NFAC,IFAC,MELRES,IJACO 62 : & ,NGF,NGC,NLF,NLC 63 : & ,ILIINC,ILIINP,IJAC 64 : & ,MP, NBEL, NBME, NBSOUS, NKID, NKMT, NMATRI, NP, NRIGE 65 : REAL*8 VOLU,SURF,RC,PC,UXC,UYC,UZC,GAMC,CNX,CNY,CNZ 66 : & ,UNC 67 : & ,GM1,USGM1,COEF,ECIN,HIN 68 : & ,DRORO,DROUX,DROUY,DROP 69 : & ,DUXRO,DUXUX,DUXUY,DUXP 70 : & ,DUYRO,DUYUX,DUYUY,DUYP 71 : & ,DPRO,DPUX,DPUY,DPP 72 : & ,DROUZ,DUXUZ,DUYUZ,DPUZ 73 : & ,DUZRO,DUZUX,DUZUY,DUZUZ,DUZP 74 : & ,COEF1,COEF2,COEF3,COEF4 75 : CHARACTER*(8) TYPE 76 : C 77 : C 78 : C**** KRIPAD pour la correspondance global/local 79 : C 79 : CALL KRIPAD(MELEMC,MLEMC) 80 : C SEGINI MLEMC 80 : CALL KRIPAD(MELECB,MLEMCB) 81 : C SEGINI MLEMCB 81 : CALL KRIPAD(MELEMF,MLEMF) 82 : C SEGINI MLEMF 83 : C 84 : C**** CHPOINTs de la table DOMAINE 85 : C 85 : CALL LICHT(INORM,MPNORM,TYPE,ICEL) 85 : CALL LICHT(ICHPVO,MPVOL,TYPE,ICEL) 85 : CALL LICHT(ICHPSU,MPSURF,TYPE,ICEL) 86 : C 87 : C**** LICHT active les MPOVALs en *MOD 88 : C 89 : C SEGACT MPNORM*MOD 90 : C SEGACT MPOVSU*MOD 91 : C SEGACT MPOVOL*MOD 92 : C 93 : C 94 : C**** CHPOINTs des variables 95 : C 95 : CALL LICHT(IROC,MPRC,TYPE,ICEL) 95 : CALL LICHT(IVITC,MPVC,TYPE,ICEL) 95 : CALL LICHT(IPC,MPPC,TYPE,ICEL) 95 : CALL LICHT(IGAMC,MPGAMC,TYPE,ICEL) 96 : C 97 : C SEGACT *MOD 98 : C SEGACT *MOD 99 : C SEGACT *MOD 100 : C SEGACT *MOD 101 : C SEGACT *MOD 102 : C 103 : C 104 : C**** Boucle sur le face pour le calcul des invariants de 105 : C Riemann et du flux 106 : C 107 : SEGACT MELEFC 108 : NFAC=MELEFC.NUM(/2) 109 : C 110 : C**** Objet MATRIK 111 : C 112 : NRIGE = 7 113 : NMATRI = 1 114 : NKID = 9 115 : NKMT = 7 116 : C 117 : SEGINI MATRIK 118 : IJACO = MATRIK 119 : MATRIK.IRIGEL(1,1) = MELRES 120 : MATRIK.IRIGEL(2,1) = MELRES 121 : C 122 : C**** Matrice non symetrique 123 : C 124 : MATRIK.IRIGEL(7,1) = 2 125 : C 126 : NBME = 25 127 : NBSOUS = 1 128 : SEGINI IMATRI 129 : IF(IJAC.EQ.1)THEN 130 : MLMOTS=ILIINC 131 : ELSEIF(IJAC.EQ.2)THEN 132 : MLMOTS=ILIINP 133 : ENDIF 134 : SEGACT MLMOTS 135 : MATRIK.IRIGEL(4,1) = IMATRI 136 : C 137 : IMATRI.LISPRI(1) = MLMOTS.MOTS(1) 138 : IMATRI.LISPRI(2) = MLMOTS.MOTS(2) 139 : IMATRI.LISPRI(3) = MLMOTS.MOTS(3) 140 : IMATRI.LISPRI(4) = MLMOTS.MOTS(4) 141 : IMATRI.LISPRI(5) = MLMOTS.MOTS(5) 142 : C 143 : IMATRI.LISPRI(6) = MLMOTS.MOTS(1) 144 : IMATRI.LISPRI(7) = MLMOTS.MOTS(2) 145 : IMATRI.LISPRI(8) = MLMOTS.MOTS(3) 146 : IMATRI.LISPRI(9) = MLMOTS.MOTS(4) 147 : IMATRI.LISPRI(10) = MLMOTS.MOTS(5) 148 : C 149 : IMATRI.LISPRI(11) = MLMOTS.MOTS(1) 150 : IMATRI.LISPRI(12) = MLMOTS.MOTS(2) 151 : IMATRI.LISPRI(13) = MLMOTS.MOTS(3) 152 : IMATRI.LISPRI(14) = MLMOTS.MOTS(4) 153 : IMATRI.LISPRI(15) = MLMOTS.MOTS(5) 154 : C 155 : IMATRI.LISPRI(16) = MLMOTS.MOTS(1) 156 : IMATRI.LISPRI(17) = MLMOTS.MOTS(2) 157 : IMATRI.LISPRI(18) = MLMOTS.MOTS(3) 158 : IMATRI.LISPRI(19) = MLMOTS.MOTS(4) 159 : IMATRI.LISPRI(20) = MLMOTS.MOTS(5) 160 : C 161 : IMATRI.LISPRI(21) = MLMOTS.MOTS(1) 162 : IMATRI.LISPRI(22) = MLMOTS.MOTS(2) 163 : IMATRI.LISPRI(23) = MLMOTS.MOTS(3) 164 : IMATRI.LISPRI(24) = MLMOTS.MOTS(4) 165 : IMATRI.LISPRI(25) = MLMOTS.MOTS(5) 166 : C 167 : SEGDES MLMOTS 168 : MLMOTS=ILIINC 169 : SEGACT MLMOTS 170 : C 171 : C 172 : IMATRI.LISDUA(1) = MLMOTS.MOTS(1) 173 : IMATRI.LISDUA(2) = MLMOTS.MOTS(1) 174 : IMATRI.LISDUA(3) = MLMOTS.MOTS(1) 175 : IMATRI.LISDUA(4) = MLMOTS.MOTS(1) 176 : IMATRI.LISDUA(5) = MLMOTS.MOTS(1) 177 : C 178 : IMATRI.LISDUA(6) = MLMOTS.MOTS(2) 179 : IMATRI.LISDUA(7) = MLMOTS.MOTS(2) 180 : IMATRI.LISDUA(8) = MLMOTS.MOTS(2) 181 : IMATRI.LISDUA(9) = MLMOTS.MOTS(2) 182 : IMATRI.LISDUA(10) = MLMOTS.MOTS(2) 183 : C 184 : IMATRI.LISDUA(11) = MLMOTS.MOTS(3) 185 : IMATRI.LISDUA(12) = MLMOTS.MOTS(3) 186 : IMATRI.LISDUA(13) = MLMOTS.MOTS(3) 187 : IMATRI.LISDUA(14) = MLMOTS.MOTS(3) 188 : IMATRI.LISDUA(15) = MLMOTS.MOTS(3) 189 : C 190 : IMATRI.LISDUA(16) = MLMOTS.MOTS(4) 191 : IMATRI.LISDUA(17) = MLMOTS.MOTS(4) 192 : IMATRI.LISDUA(18) = MLMOTS.MOTS(4) 193 : IMATRI.LISDUA(19) = MLMOTS.MOTS(4) 194 : IMATRI.LISDUA(20) = MLMOTS.MOTS(4) 195 : C 196 : IMATRI.LISDUA(21) = MLMOTS.MOTS(5) 197 : IMATRI.LISDUA(22) = MLMOTS.MOTS(5) 198 : IMATRI.LISDUA(23) = MLMOTS.MOTS(5) 199 : IMATRI.LISDUA(24) = MLMOTS.MOTS(5) 200 : IMATRI.LISDUA(25) = MLMOTS.MOTS(5) 201 : C 202 : SEGDES MLMOTS 203 : NBEL = NFAC 204 : NBSOUS = 1 205 : NP = 1 206 : MP = 1 207 : SEGINI RR , RUX , RUY , RUZ ,RRET , 208 : & UXR , UXUX , UXUY , UXUZ ,UXRET , 209 : & UYR , UYUX , UYUY , UYUZ , UYRET , 210 : & UZR , UZUX , UZUY , UZUZ , UZRET , 211 : & RETR , RETUX , RETUY, RETUZ , RETRET 212 : C 213 : C**** Duale = IMATRI.LISDUA(1) = 'RN' 214 : C Primale = IMATRI.LISPRI(1) = 'RN' 215 : C -> IMATRI.LIZAFM(1,1) = RR 216 : C 217 : IMATRI.LIZAFM(1,1) = RR 218 : IMATRI.LIZAFM(1,2) = RUX 219 : IMATRI.LIZAFM(1,3) = RUY 220 : IMATRI.LIZAFM(1,4) = RUZ 221 : IMATRI.LIZAFM(1,5) = RRET 222 : C 223 : IMATRI.LIZAFM(1,6) = UXR 224 : IMATRI.LIZAFM(1,7) = UXUX 225 : IMATRI.LIZAFM(1,8) = UXUY 226 : IMATRI.LIZAFM(1,9) = UXUZ 227 : IMATRI.LIZAFM(1,10) = UXRET 228 : C 229 : IMATRI.LIZAFM(1,11) = UYR 230 : IMATRI.LIZAFM(1,12) = UYUX 231 : IMATRI.LIZAFM(1,13) = UYUY 232 : IMATRI.LIZAFM(1,14) = UYUZ 233 : IMATRI.LIZAFM(1,15) = UYRET 234 : C 235 : IMATRI.LIZAFM(1,16) = UZR 236 : IMATRI.LIZAFM(1,17) = UZUX 237 : IMATRI.LIZAFM(1,18) = UZUY 238 : IMATRI.LIZAFM(1,19) = UZUZ 239 : IMATRI.LIZAFM(1,20) = UZRET 240 : C 241 : IMATRI.LIZAFM(1,21) = RETR 242 : IMATRI.LIZAFM(1,22) = RETUX 243 : IMATRI.LIZAFM(1,23) = RETUY 244 : IMATRI.LIZAFM(1,24) = RETUZ 245 : IMATRI.LIZAFM(1,25) = RETRET 246 : C 247 : SEGDES MATRIK 248 : SEGDES IMATRI 249 : C 250 : C**** Fin definition MATRIK 251 : C 252 : DO IFAC=1,NFAC,1 253 : NGF=MELEFC.NUM(1,IFAC) 254 : NGC=MELEFC.NUM(2,IFAC) 255 : NLF=MLEMF.LECT(NGF) 256 : NLC=MLEMC.LECT(NGC) 257 : VOLU=MPVOL.VPOCHA(NLC,1) 258 : SURF=MPSURF.VPOCHA(NLF,1) 259 : C In CASTEM les normales sont sortantes 260 : CNX=MPNORM.VPOCHA(NLF,1) 261 : CNY=MPNORM.VPOCHA(NLF,2) 262 : CNZ=MPNORM.VPOCHA(NLF,3) 263 : C Variables au centre 264 : RC=MPRC.VPOCHA(NLC,1) 265 : PC=MPPC.VPOCHA(NLC,1) 266 : UXC=MPVC.VPOCHA(NLC,1) 267 : UYC=MPVC.VPOCHA(NLC,2) 268 : UZC=MPVC.VPOCHA(NLC,3) 269 : GAMC=MPGAMC.VPOCHA(NLC,1) 270 : GM1=GAMC-1.0D0 271 : USGM1=1.0D0/GM1 272 : C 273 : C******* On calcule UN, UT 274 : C 275 : UNC=(UXC*CNX)+(UYC*CNY+(UZC*CNZ)) 276 : C 277 : C******* Densite, vitesse, pression sur le bord 278 : C 279 : COEF=-1*SURF/VOLU 280 : C 281 : DRORO=UNC*COEF 282 : DROUX=(RC*CNX)*COEF 283 : DROUY=(RC*CNY)*COEF 284 : DROUZ=(RC*CNZ)*COEF 285 : DROP=0.0D0 286 : C 287 : DUXRO=(UNC*UXC)*COEF 288 : DUXUX=((RC*CNX*UXC)+(RC*UNC))*COEF 289 : DUXUY=((RC*CNY*UXC))*COEF 290 : DUXUZ=((RC*CNZ*UXC))*COEF 291 : DUXP=CNX*COEF 292 : C 293 : DUYRO=(UNC*UYC)*COEF 294 : DUYUX=((RC*CNX*UYC))*COEF 295 : DUYUY=((RC*CNY*UYC)+(RC*UNC))*COEF 296 : DUYUZ=((RC*CNZ*UYC))*COEF 297 : DUYP=CNY*COEF 298 : C 299 : DUZRO=(UNC*UZC)*COEF 300 : DUZUX=((RC*CNX*UZC))*COEF 301 : DUZUY=((RC*CNY*UZC))*COEF 302 : DUZUZ=((RC*CNZ*UZC)+(RC*UNC))*COEF 303 : DUZP=CNZ*COEF 304 : C 305 : ECIN=0.5D0*((UXC*UXC)+(UYC*UYC)+(UZC*UZC)) 306 : HIN=GAMC*USGM1*PC 307 : DPRO=(UNC*ECIN)*COEF 308 : DPUX=((CNX*HIN)+(RC*CNX*ECIN)+(RC*UNC*UXC))*COEF 309 : DPUY=((CNY*HIN)+(RC*CNY*ECIN)+(RC*UNC*UYC))*COEF 310 : DPUZ=((CNZ*HIN)+(RC*CNZ*ECIN)+(RC*UNC*UZC))*COEF 311 : DPP=(UNC*GAMC*USGM1)*COEF 312 : CC 313 : CC******* Jacobian with respect to conservative variables 314 : CC 315 : IF(IJAC.EQ.1)THEN 316 : COEF1=-1.0D0*UXC/RC 317 : COEF2=-1.0D0*UYC/RC 318 : COEF3=-1.0D0*UZC/RC 319 : COEF4=0.5D0*GM1*((UXC*UXC)+(UYC*UYC)+(UZC*UZC)) 320 : C 321 : RR.AM(IFAC,1,1)=DRORO+(DROUX*COEF1)+(DROUY*COEF2)+(DROUZ 322 : $ *COEF3)+(DROP*COEF4) 323 : RUX.AM(IFAC,1,1)=(DROUX/RC)-((UXC*GM1)*DROP) 324 : RUY.AM(IFAC,1,1)=(DROUY/RC)-((UYC*GM1)*DROP) 325 : RUZ.AM(IFAC,1,1)=(DROUZ/RC)-((UZC*GM1)*DROP) 326 : RRET.AM(IFAC,1,1)=GM1*DROP 327 : C 328 : UXR.AM(IFAC,1,1)=DUXRO+(DUXUX*COEF1)+(DUXUY*COEF2)+(DUXUZ 329 : $ *COEF3)+(DUXP*COEF4) 330 : UXUX.AM(IFAC,1,1)=(DUXUX/RC)-((UXC*GM1)*DUXP) 331 : UXUY.AM(IFAC,1,1)=(DUXUY/RC)-((UYC*GM1)*DUXP) 332 : UXUZ.AM(IFAC,1,1)=(DUXUZ/RC)-((UZC*GM1)*DUXP) 333 : UXRET.AM(IFAC,1,1)=GM1*DUXP 334 : C 335 : UYR.AM(IFAC,1,1)=DUYRO+(DUYUX*COEF1)+(DUYUY*COEF2)+(DUYUZ 336 : $ *COEF3)+(DUYP*COEF4) 337 : UYUX.AM(IFAC,1,1)=(DUYUX/RC)-((UXC*GM1)*DUYP) 338 : UYUY.AM(IFAC,1,1)=(DUYUY/RC)-((UYC*GM1)*DUYP) 339 : UYUZ.AM(IFAC,1,1)=(DUYUZ/RC)-((UZC*GM1)*DUYP) 340 : UYRET.AM(IFAC,1,1)=GM1*DUYP 341 : C 342 : UZR.AM(IFAC,1,1)=DUZRO+(DUZUX*COEF1)+(DUZUY*COEF2)+(DUZUZ 343 : $ *COEF3)+(DUZP*COEF4) 344 : UZUX.AM(IFAC,1,1)=(DUZUX/RC)-((UXC*GM1)*DUZP) 345 : UZUY.AM(IFAC,1,1)=(DUZUY/RC)-((UYC*GM1)*DUZP) 346 : UZUZ.AM(IFAC,1,1)=(DUZUZ/RC)-((UZC*GM1)*DUZP) 347 : UZRET.AM(IFAC,1,1)=GM1*DUZP 348 : C 349 : RETR.AM(IFAC,1,1)=DPRO+(DPUX*COEF1)+(DPUY*COEF2)+(DPUZ 350 : $ *COEF3)+(DPP*COEF4) 351 : RETUX.AM(IFAC,1,1)=(DPUX/RC)-((UXC*GM1)*DPP) 352 : RETUY.AM(IFAC,1,1)=(DPUY/RC)-((UYC*GM1)*DPP) 353 : RETUZ.AM(IFAC,1,1)=(DPUZ/RC)-((UZC*GM1)*DPP) 354 : RETRET.AM(IFAC,1,1)=GM1*DPP 355 : C 356 : ELSEIF(IJAC.EQ.2)THEN 357 : RR.AM(IFAC,1,1)=DRORO 358 : RUX.AM(IFAC,1,1)=DROUX 359 : RUY.AM(IFAC,1,1)=DROUY 360 : RUZ.AM(IFAC,1,1)=DROUZ 361 : RRET.AM(IFAC,1,1)=DROP 362 : C 363 : UXR.AM(IFAC,1,1)=DUXRO 364 : UXUX.AM(IFAC,1,1)=DUXUX 365 : UXUY.AM(IFAC,1,1)=DUXUY 366 : UXUZ.AM(IFAC,1,1)=DUXUZ 367 : UXRET.AM(IFAC,1,1)=DUXP 368 : C 369 : UYR.AM(IFAC,1,1)=DUYRO 370 : UYUX.AM(IFAC,1,1)=DUYUX 371 : UYUY.AM(IFAC,1,1)=DUYUY 372 : UYUZ.AM(IFAC,1,1)=DUYUZ 373 : UYRET.AM(IFAC,1,1)=DUYP 374 : C 375 : UZR.AM(IFAC,1,1)=DUZRO 376 : UZUX.AM(IFAC,1,1)=DUZUX 377 : UZUY.AM(IFAC,1,1)=DUZUY 378 : UZUZ.AM(IFAC,1,1)=DUZUZ 379 : UZRET.AM(IFAC,1,1)=DUZP 380 : C 381 : RETR.AM(IFAC,1,1)=DPRO 382 : RETUX.AM(IFAC,1,1)=DPUX 383 : RETUY.AM(IFAC,1,1)=DPUY 384 : RETUZ.AM(IFAC,1,1)=DPUZ 385 : RETRET.AM(IFAC,1,1)=DPP 386 : 387 : ENDIF 388 : ENDDO 389 : C 390 : SEGDES MELEFC 391 : C 392 : SEGSUP MLEMC 393 : SEGSUP MLEMCB 394 : SEGSUP MLEMF 395 : C 396 : SEGDES MPNORM 397 : SEGDES MPVOL 398 : SEGDES MPSURF 399 : SEGDES MPRC 400 : SEGDES MPPC 401 : SEGDES MPVC 402 : SEGDES MPGAMC 403 : C 404 : SEGDES RR , RUX , RUY , RUZ ,RRET , 405 : & UXR , UXUX , UXUY , UXUZ ,UXRET , 406 : & UYR , UYUX , UYUY , UYUZ , UYRET , 407 : & UZR , UZUX , UZUY , UZUZ , UZRET , 408 : & RETR , RETUX , RETUY, RETUZ , RETRET 409 : C 410 : 9999 CONTINUE 411 : RETURN 412 : END 413 : 414 : 415 : 416 : 417 : 418 : 419 : 420 : 421 :
© Cast3M 2003 - All rights reserved.
Disclaimer