1 : C CLI172 SOURCE MAGN 09/07/30 21:15:57 6458 2 : SUBROUTINE CLI172(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 : CLI172 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,GAMC,CNX,CNY,GM1 63 : & ,RC,UXC,UYC 64 : & ,PC,PSRF,RHOUF,P,RHO,UN 65 : & ,DECIDP,DUNDPC,DUXDPC,DUYDPC 66 : & ,DRORO,DROUX,DROUY,DROP 67 : & ,DUXRO,DUXUX,DUXUY,DUXP 68 : & ,DUYRO,DUYUX,DUYUY,DUYP 69 : & ,DPRO,DPUX,DPUY,DPP 70 : & ,COEF1,COEF2,COEF3,COEF 71 : CHARACTER*(8) TYPE 72 : C 73 : C 74 : C**** KRIPAD pour la correspondance global/local 75 : C 75 : CALL KRIPAD(MELEMC,MLEMC) 76 : C SEGINI MLEMC 76 : CALL KRIPAD(MELECB,MLEMCB) 77 : C SEGINI MLEMCB 77 : CALL KRIPAD(MELEMF,MLEMF) 78 : C SEGINI MLEMF 79 : C 80 : C**** CHPOINTs de la table DOMAINE 81 : C 81 : CALL LICHT(INORM,MPNORM,TYPE,ICEL) 81 : CALL LICHT(ICHPVO,MPVOL,TYPE,ICEL) 81 : CALL LICHT(ICHPSU,MPSURF,TYPE,ICEL) 82 : C 83 : C**** LICHT active les MPOVALs en *MOD 84 : C 85 : C SEGACT MPNORM*MOD 86 : C SEGACT MPOVSU*MOD 87 : C SEGACT MPOVOL*MOD 88 : C 89 : C 90 : C**** CHPOINTs des variables 91 : C 91 : CALL LICHT(IROC,MPRC,TYPE,ICEL) 91 : CALL LICHT(IVITC,MPVC,TYPE,ICEL) 91 : CALL LICHT(IPC,MPPC,TYPE,ICEL) 91 : CALL LICHT(IGAMC,MPGAMC,TYPE,ICEL) 91 : CALL LICHT(ICHLIM,MPLIM,TYPE,ICEL) 92 : C 93 : C SEGACT *MOD 94 : C SEGACT *MOD 95 : C SEGACT *MOD 96 : C SEGACT *MOD 97 : C SEGACT *MOD 98 : C 99 : C 100 : C**** Boucle sur le face pour le calcul des invariants de 101 : C Riemann et du flux 102 : C 103 : SEGACT MELEFC 104 : NFAC=MELEFC.NUM(/2) 105 : C 106 : C**** Objet MATRIK 107 : C 108 : NRIGE = 7 109 : NMATRI = 1 110 : NKID = 9 111 : NKMT = 7 112 : C 113 : SEGINI MATRIK 114 : IJACO = MATRIK 115 : MATRIK.IRIGEL(1,1) = MELRES 116 : MATRIK.IRIGEL(2,1) = MELRES 117 : C 118 : C**** Matrice non symetrique 119 : C 120 : MATRIK.IRIGEL(7,1) = 2 121 : C 122 : NBME = 16 123 : NBSOUS = 1 124 : SEGINI IMATRI 125 : IF(IJAC.EQ.1)THEN 126 : MLMOTS=ILIINC 127 : ELSEIF(IJAC.EQ.2)THEN 128 : MLMOTS=ILIINP 129 : ENDIF 130 : SEGACT MLMOTS 131 : MATRIK.IRIGEL(4,1) = IMATRI 132 : C 133 : IMATRI.LISPRI(1) = MLMOTS.MOTS(1) 134 : IMATRI.LISPRI(2) = MLMOTS.MOTS(2) 135 : IMATRI.LISPRI(3) = MLMOTS.MOTS(3) 136 : IMATRI.LISPRI(4) = MLMOTS.MOTS(4) 137 : IMATRI.LISPRI(5) = MLMOTS.MOTS(1) 138 : IMATRI.LISPRI(6) = MLMOTS.MOTS(2) 139 : IMATRI.LISPRI(7) = MLMOTS.MOTS(3) 140 : IMATRI.LISPRI(8) = MLMOTS.MOTS(4) 141 : IMATRI.LISPRI(9) = MLMOTS.MOTS(1) 142 : IMATRI.LISPRI(10) = MLMOTS.MOTS(2) 143 : IMATRI.LISPRI(11) = MLMOTS.MOTS(3) 144 : IMATRI.LISPRI(12) = MLMOTS.MOTS(4) 145 : IMATRI.LISPRI(13) = MLMOTS.MOTS(1) 146 : IMATRI.LISPRI(14) = MLMOTS.MOTS(2) 147 : IMATRI.LISPRI(15) = MLMOTS.MOTS(3) 148 : IMATRI.LISPRI(16) = MLMOTS.MOTS(4) 149 : C 150 : SEGDES MLMOTS 151 : MLMOTS=ILIINC 152 : SEGACT MLMOTS 153 : C 154 : IMATRI.LISDUA(1) = MLMOTS.MOTS(1) 155 : IMATRI.LISDUA(2) = MLMOTS.MOTS(1) 156 : IMATRI.LISDUA(3) = MLMOTS.MOTS(1) 157 : IMATRI.LISDUA(4) = MLMOTS.MOTS(1) 158 : IMATRI.LISDUA(5) = MLMOTS.MOTS(2) 159 : IMATRI.LISDUA(6) = MLMOTS.MOTS(2) 160 : IMATRI.LISDUA(7) = MLMOTS.MOTS(2) 161 : IMATRI.LISDUA(8) = MLMOTS.MOTS(2) 162 : IMATRI.LISDUA(9) = MLMOTS.MOTS(3) 163 : IMATRI.LISDUA(10) = MLMOTS.MOTS(3) 164 : IMATRI.LISDUA(11) = MLMOTS.MOTS(3) 165 : IMATRI.LISDUA(12) = MLMOTS.MOTS(3) 166 : IMATRI.LISDUA(13) = MLMOTS.MOTS(4) 167 : IMATRI.LISDUA(14) = MLMOTS.MOTS(4) 168 : IMATRI.LISDUA(15) = MLMOTS.MOTS(4) 169 : IMATRI.LISDUA(16) = MLMOTS.MOTS(4) 170 : C 171 : SEGDES MLMOTS 172 : NBEL = NFAC 173 : NBSOUS = 1 174 : NP = 1 175 : MP = 1 176 : SEGINI RR , RUX , RUY , RRET , 177 : & UXR , UXUX , UXUY , UXRET , 178 : & UYR , UYUX , UYUY , UYRET , 179 : & RETR , RETUX , RETUY , RETRET 180 : C 181 : C**** Duale = IMATRI.LISDUA(1) = 'RN' 182 : C Primale = IMATRI.LISPRI(1) = 'RN' 183 : C -> IMATRI.LIZAFM(1,1) = RR 184 : C 185 : IMATRI.LIZAFM(1,1) = RR 186 : IMATRI.LIZAFM(1,2) = RUX 187 : IMATRI.LIZAFM(1,3) = RUY 188 : IMATRI.LIZAFM(1,4) = RRET 189 : IMATRI.LIZAFM(1,5) = UXR 190 : IMATRI.LIZAFM(1,6) = UXUX 191 : IMATRI.LIZAFM(1,7) = UXUY 192 : IMATRI.LIZAFM(1,8) = UXRET 193 : IMATRI.LIZAFM(1,9) = UYR 194 : IMATRI.LIZAFM(1,10) = UYUX 195 : IMATRI.LIZAFM(1,11) = UYUY 196 : IMATRI.LIZAFM(1,12) = UYRET 197 : IMATRI.LIZAFM(1,13) = RETR 198 : IMATRI.LIZAFM(1,14) = RETUX 199 : IMATRI.LIZAFM(1,15) = RETUY 200 : IMATRI.LIZAFM(1,16) = RETRET 201 : C 202 : SEGDES MATRIK 203 : SEGDES IMATRI 204 : C 205 : C**** Fin definition MATRIK 206 : C 207 : DO IFAC=1,NFAC,1 208 : NGF=MELEFC.NUM(1,IFAC) 209 : NGC=MELEFC.NUM(2,IFAC) 210 : NLF=MLEMF.LECT(NGF) 211 : NLC=MLEMC.LECT(NGC) 212 : NLCB=MLEMCB.LECT(NGF) 213 : VOLU=MPVOL.VPOCHA(NLC,1) 214 : SURF=MPSURF.VPOCHA(NLF,1) 215 : C In CASTEM les normales sont sortantes 216 : CNX=-1*MPNORM.VPOCHA(NLF,1) 217 : CNY=-1*MPNORM.VPOCHA(NLF,2) 218 : C Variables au centre 219 : GAMC=MPGAMC.VPOCHA(NLC,1) 220 : GM1=GAMC-1.0D0 221 : PC=MPPC.VPOCHA(NLC,1) 222 : RC=MPRC.VPOCHA(NLC,1) 223 : UXC=MPVC.VPOCHA(NLC,1) 224 : UYC=MPVC.VPOCHA(NLC,2) 225 : C Variables à la face 226 : RHOUF=MPLIM.VPOCHA(NLCB,1) 227 : PSRF=MPLIM.VPOCHA(NLCB,2) 228 : C 229 : C******* Variables à l'interface 230 : C 231 : P=PC 232 : RHO=P/PSRF 233 : UN=RHOUF/RHO 234 : C 235 : C******* Derivative with respect to PC 236 : C 237 : DUNDPC=-1*RHOUF/(RHO*RHO*PSRF) 238 : DUXDPC=CNX*DUNDPC 239 : DUYDPC=CNY*DUNDPC 240 : DECIDP=UN*DUNDPC 241 : C 242 : C******* Jacobian with respect to primitive variables 243 : C 244 : COEF=SURF/VOLU 245 : DRORO=0.0D0 246 : DROUX=0.0D0 247 : DROUY=0.0D0 248 : DROP=0.0D0 249 : C 250 : DPRO=0.0D0 251 : DPUX=0.0D0 252 : DPUY=0.0D0 253 : DPP=(RHOUF*DECIDP)*COEF 254 : C 255 : DUXRO=0.0D0 256 : DUXUX=0.0D0 257 : DUXUY=0.0D0 258 : DUXP =(RHOUF*DUXDPC+CNX)*COEF 259 : C 260 : DUYRO=0.0D0 261 : DUYUX=0.0D0 262 : DUYUY=0.0D0 263 : DUYP =(RHOUF*DUYDPC+CNY)*COEF 264 : C 265 : C******* Jacobian with respect to conservative variables 266 : C 267 : IF(IJAC.EQ.1)THEN 268 : 269 : COEF1=-1.0D0*UXC/RC 270 : COEF2=-1.0D0*UYC/RC 271 : COEF3=0.5D0*GM1*((UXC*UXC)+(UYC*UYC)) 272 : C 273 : RR.AM(IFAC,1,1)=DRORO+(DROUX*COEF1)+(DROUY*COEF2)+(DROP 274 : $ *COEF3) 275 : RUX.AM(IFAC,1,1)=(DROUX/RC)-((UXC*GM1)*DROP) 276 : RUY.AM(IFAC,1,1)=(DROUY/RC)-((UYC*GM1)*DROP) 277 : RRET.AM(IFAC,1,1)=GM1*DROP 278 : C 279 : UXR.AM(IFAC,1,1)=DUXRO+(DUXUX*COEF1)+(DUXUY*COEF2)+(DUXP 280 : $ *COEF3) 281 : UXUX.AM(IFAC,1,1)=(DUXUX/RC)-((UXC*GM1)*DUXP) 282 : UXUY.AM(IFAC,1,1)=(DUXUY/RC)-((UYC*GM1)*DUXP) 283 : UXRET.AM(IFAC,1,1)=GM1*DUXP 284 : C 285 : UYR.AM(IFAC,1,1)=DUYRO+(DUYUX*COEF1)+(DUYUY*COEF2)+(DUYP 286 : $ *COEF3) 287 : UYUX.AM(IFAC,1,1)=(DUYUX/RC)-((UXC*GM1)*DUYP) 288 : UYUY.AM(IFAC,1,1)=(DUYUY/RC)-((UYC*GM1)*DUYP) 289 : UYRET.AM(IFAC,1,1)=GM1*DUYP 290 : C 291 : RETR.AM(IFAC,1,1)=DPRO+(DPUX*COEF1)+(DPUY*COEF2)+(DPP 292 : $ *COEF3) 293 : RETUX.AM(IFAC,1,1)=(DPUX/RC)-((UXC*GM1)*DPP) 294 : RETUY.AM(IFAC,1,1)=(DPUY/RC)-((UYC*GM1)*DPP) 295 : RETRET.AM(IFAC,1,1)=GM1*DPP 296 : C 297 : ELSEIF(IJAC.EQ.2)THEN 298 : RR.AM(IFAC,1,1)=DRORO 299 : RUX.AM(IFAC,1,1)=DROUX 300 : RUY.AM(IFAC,1,1)=DROUY 301 : RRET.AM(IFAC,1,1)=DROP 302 : C 303 : UXR.AM(IFAC,1,1)=DUXRO 304 : UXUX.AM(IFAC,1,1)=DUXUX 305 : UXUY.AM(IFAC,1,1)=DUXUY 306 : UXRET.AM(IFAC,1,1)=DUXP 307 : C 308 : UYR.AM(IFAC,1,1)=DUYRO 309 : UYUX.AM(IFAC,1,1)=DUYUX 310 : UYUY.AM(IFAC,1,1)=DUYUY 311 : UYRET.AM(IFAC,1,1)=DUYP 312 : C 313 : RETR.AM(IFAC,1,1)=DPRO 314 : RETUX.AM(IFAC,1,1)=DPUX 315 : RETUY.AM(IFAC,1,1)=DPUY 316 : RETRET.AM(IFAC,1,1)=DPP 317 : ENDIF 318 : ENDDO 319 : C 320 : SEGDES MELEFC 321 : C 322 : SEGSUP MLEMC 323 : SEGSUP MLEMCB 324 : SEGSUP MLEMF 325 : C 326 : SEGDES MPNORM 327 : SEGDES MPVOL 328 : SEGDES MPSURF 329 : SEGDES MPRC 330 : SEGDES MPPC 331 : SEGDES MPVC 332 : SEGDES MPGAMC 333 : SEGDES MPLIM 334 : C 335 : SEGDES RR , RUX , RUY , RRET , 336 : & UXR , UXUX , UXUY , UXRET , 337 : & UYR , UYUX , UYUY , UYRET , 338 : & RETR , RETUX , RETUY , RETRET 339 : C 340 : 9999 CONTINUE 341 : RETURN 342 : END 343 : 344 : 345 : 346 : 347 : 348 : 349 : 350 : 351 :
© Cast3M 2003 - All rights reserved.
Disclaimer