1 : C CLI112 SOURCE MAGN 09/07/30 21:15:33 6458 2 : SUBROUTINE CLI112(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 : CLI112 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 : C 44 : C**** Variables de COOPTIO 45 : C 46 : C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR 47 : C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ 48 : C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES 49 : C & ,IECHO, IIMPI, IOSPI 50 : C & ,IDIM, IFICLE, IPREFI 51 : C & ,MCOORD 52 : C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE 53 : C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU 54 : C & ,NORINC,NORVAL,NORIND,NORVAD 55 : C & ,NUCROU, IPSAUV 56 : C 57 : INTEGER MELEMF,MELEMC,MELECB,INORM,ICHPVO,ICHPSU, IROC,IVITC,IPC 58 : & ,IGAMC,ICHLIM,ICEL,NFAC,IFAC,MELRES,IJACO 59 : & ,NGF,NGC,NLF,NLC,NLCB 60 : & ,ILIINC,ILIINP,IJAC 61 : & ,MP, NBEL, NBME, NBSOUS, NKID, NKMT, NMATRI, NP, NRIGE 62 : REAL*8 VOLU,SURF,RC,PC,UXC,UYC,GAMC,CNX,CNY,CTX,CTY 63 : & ,RF,PF,UXF,UYF 64 : & ,UNC,UNF,UTF,SF,ASONC,ASONF,ASON 65 : * & ,UTC,SC 66 : & ,GM1,USGM1,DSGM1,G1,G3,ASON2,S,UT,UN,RHO,P,UX,UY 67 : & ,DUNDG1,DASDG1,DRHDG1,DPDG1,DUXDG1,DUYDG1 68 : * & ,CELL,EPS,CACCA 69 : & ,DFRDG1,DFMXG1,DFMYG1,DFEDG1 70 : & ,DG1DR,DG1DP,DG1DUX,DG1DUY,COEF 71 : & ,DRORO,DROUX,DROUY,DROP 72 : & ,DUXRO,DUXUX,DUXUY,DUXP 73 : & ,DUYRO,DUYUX,DUYUY,DUYP 74 : & ,DPRO,DPUX,DPUY,DPP 75 : & ,COEF1,COEF2,COEF3 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 = 16 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(1) 143 : IMATRI.LISPRI(6) = MLMOTS.MOTS(2) 144 : IMATRI.LISPRI(7) = MLMOTS.MOTS(3) 145 : IMATRI.LISPRI(8) = MLMOTS.MOTS(4) 146 : IMATRI.LISPRI(9) = MLMOTS.MOTS(1) 147 : IMATRI.LISPRI(10) = MLMOTS.MOTS(2) 148 : IMATRI.LISPRI(11) = MLMOTS.MOTS(3) 149 : IMATRI.LISPRI(12) = MLMOTS.MOTS(4) 150 : IMATRI.LISPRI(13) = MLMOTS.MOTS(1) 151 : IMATRI.LISPRI(14) = MLMOTS.MOTS(2) 152 : IMATRI.LISPRI(15) = MLMOTS.MOTS(3) 153 : IMATRI.LISPRI(16) = MLMOTS.MOTS(4) 154 : C 155 : SEGDES MLMOTS 156 : MLMOTS=ILIINC 157 : SEGACT MLMOTS 158 : C 159 : IMATRI.LISDUA(1) = MLMOTS.MOTS(1) 160 : IMATRI.LISDUA(2) = MLMOTS.MOTS(1) 161 : IMATRI.LISDUA(3) = MLMOTS.MOTS(1) 162 : IMATRI.LISDUA(4) = MLMOTS.MOTS(1) 163 : IMATRI.LISDUA(5) = MLMOTS.MOTS(2) 164 : IMATRI.LISDUA(6) = MLMOTS.MOTS(2) 165 : IMATRI.LISDUA(7) = MLMOTS.MOTS(2) 166 : IMATRI.LISDUA(8) = MLMOTS.MOTS(2) 167 : IMATRI.LISDUA(9) = MLMOTS.MOTS(3) 168 : IMATRI.LISDUA(10) = MLMOTS.MOTS(3) 169 : IMATRI.LISDUA(11) = MLMOTS.MOTS(3) 170 : IMATRI.LISDUA(12) = MLMOTS.MOTS(3) 171 : IMATRI.LISDUA(13) = MLMOTS.MOTS(4) 172 : IMATRI.LISDUA(14) = MLMOTS.MOTS(4) 173 : IMATRI.LISDUA(15) = MLMOTS.MOTS(4) 174 : IMATRI.LISDUA(16) = MLMOTS.MOTS(4) 175 : C 176 : SEGDES MLMOTS 177 : NBEL = NFAC 178 : NBSOUS = 1 179 : NP = 1 180 : MP = 1 181 : SEGINI RR , RUX , RUY , RRET , 182 : & UXR , UXUX , UXUY , UXRET , 183 : & UYR , UYUX , UYUY , UYRET , 184 : & RETR , RETUX , RETUY , RETRET 185 : C 186 : C**** Duale = IMATRI.LISDUA(1) = 'RN' 187 : C Primale = IMATRI.LISPRI(1) = 'RN' 188 : C -> IMATRI.LIZAFM(1,1) = RR 189 : C 190 : IMATRI.LIZAFM(1,1) = RR 191 : IMATRI.LIZAFM(1,2) = RUX 192 : IMATRI.LIZAFM(1,3) = RUY 193 : IMATRI.LIZAFM(1,4) = RRET 194 : IMATRI.LIZAFM(1,5) = UXR 195 : IMATRI.LIZAFM(1,6) = UXUX 196 : IMATRI.LIZAFM(1,7) = UXUY 197 : IMATRI.LIZAFM(1,8) = UXRET 198 : IMATRI.LIZAFM(1,9) = UYR 199 : IMATRI.LIZAFM(1,10) = UYUX 200 : IMATRI.LIZAFM(1,11) = UYUY 201 : IMATRI.LIZAFM(1,12) = UYRET 202 : IMATRI.LIZAFM(1,13) = RETR 203 : IMATRI.LIZAFM(1,14) = RETUX 204 : IMATRI.LIZAFM(1,15) = RETUY 205 : IMATRI.LIZAFM(1,16) = RETRET 206 : C 207 : SEGDES MATRIK 208 : SEGDES IMATRI 209 : C 210 : C**** Fin definition MATRIK 211 : C 212 : DO IFAC=1,NFAC,1 213 : NGF=MELEFC.NUM(1,IFAC) 214 : NGC=MELEFC.NUM(2,IFAC) 215 : NLF=MLEMF.LECT(NGF) 216 : NLC=MLEMC.LECT(NGC) 217 : NLCB=MLEMCB.LECT(NGF) 218 : VOLU=MPVOL.VPOCHA(NLC,1) 219 : SURF=MPSURF.VPOCHA(NLF,1) 220 : C In CASTEM les normales sont sortantes 221 : CNX=-1*MPNORM.VPOCHA(NLF,1) 222 : CNY=-1*MPNORM.VPOCHA(NLF,2) 223 : CTX=-1.0D0*CNY 224 : CTY=CNX 225 : C Variables au centre 226 : RC=MPRC.VPOCHA(NLC,1) 227 : PC=MPPC.VPOCHA(NLC,1) 228 : UXC=MPVC.VPOCHA(NLC,1) 229 : UYC=MPVC.VPOCHA(NLC,2) 230 : GAMC=MPGAMC.VPOCHA(NLC,1) 231 : C Variables à la face 232 : RF=MPLIM.VPOCHA(NLCB,1) 233 : UXF=MPLIM.VPOCHA(NLCB,2) 234 : UYF=MPLIM.VPOCHA(NLCB,3) 235 : PF=MPLIM.VPOCHA(NLCB,IDIM+2) 236 : C 237 : C******* On calcule UN, UT ASON, S 238 : C 239 : UNC=(UXC*CNX)+(UYC*CNY) 240 : * UTC=(UXC*CTX)+(UYC*CTY) 241 : UNF=(UXF*CNX)+(UYF*CNY) 242 : UTF=(UXF*CTX)+(UYF*CTY) 243 : C 244 : ASONC=(GAMC*PC/RC)**0.5D0 245 : ASONF=(GAMC*PF/RF)**0.5D0 246 : C 247 : * SC=PC/(RC**GAMC) 248 : SF=PF/(RF**GAMC) 249 : C 250 : C******* Densite, vitesse, pression sur le bord 251 : C 252 : GM1=(GAMC-1.0D0) 253 : USGM1=1.0D0/GM1 254 : DSGM1=2.0D0*USGM1 255 : G1=UNC-(DSGM1*ASONC) 256 : G3=UNF+(DSGM1*ASONF) 257 : UN=0.5D0*(G1+G3) 258 : ASON=(0.5D0*(G3-G1)) 259 : ASON=ASON/DSGM1 260 : ASON2=ASON*ASON 261 : S=SF 262 : UT=UTF 263 : RHO=ASON2/(GAMC*S) 264 : RHO=RHO**USGM1 265 : P=RHO*ASON2/GAMC 266 : UX=(UN*CNX)+(UT*CTX) 267 : UY=(UN*CNY)+(UT*CTY) 268 : C 269 : C******* Derivatives 270 : C 271 : DUNDG1=0.5D0 272 : DASDG1=-0.5D0/DSGM1 273 : DRHDG1=GAMC*S 274 : DRHDG1=1.0D0/DRHDG1 275 : DRHDG1=DRHDG1**USGM1 276 : DRHDG1=DRHDG1*DSGM1 277 : DRHDG1=DRHDG1*(ASON**((3.0D0-GAMC)/(GAMC-1.0D0))) 278 : DRHDG1=DRHDG1*DASDG1 279 : DPDG1=((ASON2/GAMC)*DRHDG1)+(((2*ASON*RHO)/GAMC)*DASDG1) 280 : CC 281 : CC******* Test 282 : CC 283 : C DFEDG1=(DUNDG1*GAMC*USGM1*P) + (UN*GAMC*USGM1*DPDG1) + 284 : C & (0.5D0*DRHDG1*UN*((UN*UN)+(UT*UT))) + 285 : C & (0.5D0*RHO*DUNDG1*((UN*UN)+(UT*UT))) + 286 : C & (RHO*UN*UN*DUNDG1) 287 : C CACCA=UN*GAMC*USGM1*P + 0.5D0*RHO*UN*(UN*UN+UT*UT) 288 : C EPS=1.0D-6 289 : C G1=G1*(1+EPS) 290 : C CELL=UN 291 : C UN=0.5D0*(G1+G3) 292 : C write(*,*) DUNDG1, ((UN - CELL)/(EPS*G1)) 293 : C CELL=ASON 294 : C ASON=(0.5D0*(G3-G1)) 295 : C ASON=ASON/DSGM1 296 : C write(*,*) DASDG1, ((ASON - CELL)/(EPS*G1)) 297 : C ASON2=ASON*ASON 298 : C S=SF 299 : C UT=UTF 300 : C CELL=RHO 301 : C RHO=ASON2/(GAMC*S) 302 : C RHO=RHO**USGM1 303 : C write(*,*) DRHDG1, ((RHO - CELL)/(EPS*G1)) 304 : C CELL=P 305 : C P=RHO*ASON2/GAMC 306 : C write(*,*) DPDG1, ((P - CELL)/(EPS*G1)) 307 : C CELL=CACCA 308 : C CACCA=UN*GAMC*USGM1*P + 0.5D0*RHO*UN*(UN*UN+UT*UT) 309 : C write(*,*) DFEDG1, ((CACCA - CELL)/(EPS*G1)) 310 : CC 311 : CC************************************************************ 312 : CC 313 : DUXDG1=DUNDG1*CNX 314 : DUYDG1=DUNDG1*CNY 315 : C 316 : DFRDG1=(DRHDG1*UN)+(RHO*DUNDG1) 317 : DFMXG1=(DRHDG1*UN*UX)+(RHO*DUNDG1*UX)+ 318 : & (RHO*UN*DUXDG1)+(DPDG1*CNX) 319 : DFMYG1=(DRHDG1*UN*UY)+(RHO*DUNDG1*UY)+ 320 : & (RHO*UN*DUYDG1)+(DPDG1*CNY) 321 : DFEDG1=(DUNDG1*GAMC*USGM1*P) + (UN*GAMC*USGM1*DPDG1) + 322 : & (0.5D0*DRHDG1*UN*((UN*UN)+(UT*UT))) + 323 : & (0.5D0*RHO*DUNDG1*((UN*UN)+(UT*UT))) + 324 : & (RHO*UN*UN*DUNDG1) 325 : C 326 : C******* Jacobian with respect to primitive variables 327 : C 328 : DG1DR=USGM1*ASONC/RC 329 : DG1DP=-1.0D0*USGM1*ASONC/PC 330 : DG1DUX=CNX 331 : DG1DUY=CNY 332 : C 333 : COEF=SURF/VOLU 334 : C 335 : DRORO=DFRDG1*DG1DR*COEF 336 : DROUX=DFRDG1*DG1DUX*COEF 337 : DROUY=DFRDG1*DG1DUY*COEF 338 : DROP=DFRDG1*DG1DP*COEF 339 : C 340 : DUXRO=DFMXG1*DG1DR*COEF 341 : DUXUX=DFMXG1*DG1DUX*COEF 342 : DUXUY=DFMXG1*DG1DUY*COEF 343 : DUXP=DFMXG1*DG1DP*COEF 344 : C 345 : DUYRO=DFMYG1*DG1DR*COEF 346 : DUYUX=DFMYG1*DG1DUX*COEF 347 : DUYUY=DFMYG1*DG1DUY*COEF 348 : DUYP=DFMYG1*DG1DP*COEF 349 : C 350 : DPRO=DFEDG1*DG1DR*COEF 351 : DPUX=DFEDG1*DG1DUX*COEF 352 : DPUY=DFEDG1*DG1DUY*COEF 353 : DPP=DFEDG1*DG1DP*COEF 354 : C 355 : C******* Jacobian with respect to conservative variables 356 : C 357 : IF(IJAC.EQ.1)THEN 358 : C 359 : COEF1=-1.0D0*UXC/RC 360 : COEF2=-1.0D0*UYC/RC 361 : COEF3=0.5D0*GM1*((UXC*UXC)+(UYC*UYC)) 362 : C 363 : RR.AM(IFAC,1,1)=DRORO+(DROUX*COEF1)+(DROUY*COEF2)+(DROP 364 : $ *COEF3) 365 : RUX.AM(IFAC,1,1)=(DROUX/RC)-((UXC*GM1)*DROP) 366 : RUY.AM(IFAC,1,1)=(DROUY/RC)-((UYC*GM1)*DROP) 367 : RRET.AM(IFAC,1,1)=GM1*DROP 368 : C 369 : UXR.AM(IFAC,1,1)=DUXRO+(DUXUX*COEF1)+(DUXUY*COEF2)+(DUXP 370 : $ *COEF3) 371 : UXUX.AM(IFAC,1,1)=(DUXUX/RC)-((UXC*GM1)*DUXP) 372 : UXUY.AM(IFAC,1,1)=(DUXUY/RC)-((UYC*GM1)*DUXP) 373 : UXRET.AM(IFAC,1,1)=GM1*DUXP 374 : C 375 : UYR.AM(IFAC,1,1)=DUYRO+(DUYUX*COEF1)+(DUYUY*COEF2)+(DUYP 376 : $ *COEF3) 377 : UYUX.AM(IFAC,1,1)=(DUYUX/RC)-((UXC*GM1)*DUYP) 378 : UYUY.AM(IFAC,1,1)=(DUYUY/RC)-((UYC*GM1)*DUYP) 379 : UYRET.AM(IFAC,1,1)=GM1*DUYP 380 : C 381 : RETR.AM(IFAC,1,1)=DPRO+(DPUX*COEF1)+(DPUY*COEF2)+(DPP 382 : $ *COEF3) 383 : RETUX.AM(IFAC,1,1)=(DPUX/RC)-((UXC*GM1)*DPP) 384 : RETUY.AM(IFAC,1,1)=(DPUY/RC)-((UYC*GM1)*DPP) 385 : RETRET.AM(IFAC,1,1)=GM1*DPP 386 : C 387 : ELSEIF(IJAC.EQ.2)THEN 388 : RR.AM(IFAC,1,1)=DRORO 389 : RUX.AM(IFAC,1,1)=DROUX 390 : RUY.AM(IFAC,1,1)=DROUY 391 : RRET.AM(IFAC,1,1)=DROP 392 : C 393 : UXR.AM(IFAC,1,1)=DUXRO 394 : UXUX.AM(IFAC,1,1)=DUXUX 395 : UXUY.AM(IFAC,1,1)=DUXUY 396 : UXRET.AM(IFAC,1,1)=DUXP 397 : C 398 : UYR.AM(IFAC,1,1)=DUYRO 399 : UYUX.AM(IFAC,1,1)=DUYUX 400 : UYUY.AM(IFAC,1,1)=DUYUY 401 : UYRET.AM(IFAC,1,1)=DUYP 402 : C 403 : RETR.AM(IFAC,1,1)=DPRO 404 : RETUX.AM(IFAC,1,1)=DPUX 405 : RETUY.AM(IFAC,1,1)=DPUY 406 : RETRET.AM(IFAC,1,1)=DPP 407 : ENDIF 408 : 409 : ENDDO 410 : C 411 : SEGDES MELEFC 412 : C 413 : SEGSUP MLEMC 414 : SEGSUP MLEMCB 415 : SEGSUP MLEMF 416 : C 417 : SEGDES MPNORM 418 : SEGDES MPVOL 419 : SEGDES MPSURF 420 : SEGDES MPRC 421 : SEGDES MPPC 422 : SEGDES MPVC 423 : SEGDES MPGAMC 424 : SEGDES MPLIM 425 : C 426 : SEGDES RR , RUX , RUY , RRET , 427 : & UXR , UXUX , UXUY , UXRET , 428 : & UYR , UYUX , UYUY , UYRET , 429 : & RETR , RETUX , RETUY , RETRET 430 : C 431 : 9999 CONTINUE 432 : RETURN 433 : END 434 : 435 : 436 : 437 : 438 : 439 : 440 : 441 : 442 :
© Cast3M 2003 - All rights reserved.
Disclaimer