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