1 : C CLI183 SOURCE MAGN 09/07/30 21:16:05 6458 2 : SUBROUTINE CLI183(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 : CLI183 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,CC,UNC 67 : & ,PC,PSRF,RHOUF,P,RHO,UN,ACEL,BCEL,CCEL,PSTAR,UX,UY,UZ,ECIN 68 : & ,DADR,DADP,DBDR,DBDP,DBDUX,DBDUY,DBDUZ,DCDP 69 : & ,DPSDA,DPSDB,DPSDC,DPDR,DPDP,DPDUX,DPDUY,DPDUZ 70 : & ,DUXDP,DUYDP,DUZDP,DECINP,DF2DP,DF3DP,DF4DP,DF5DP 71 : & ,DRORO,DROUX,DROUY,DROP 72 : & ,DUXRO,DUXUX,DUXUY,DUXP 73 : & ,DUYRO,DUYUX,DUYUY,DUYP 74 : & ,DPRO,DPUX,DPUY,DPP 75 : & ,COEF1,COEF2,COEF3,COEF,COEF4 76 : & ,DROUZ,DUXUZ,DUYUZ,DPUZ 77 : & ,DUZRO,DUZUX,DUZUY,DUZUZ,DUZP 78 : C & ,YCAC,YCAC2,YCAC3,YCAC4,XCAC,F1,F2,F3,F4,F5,USGM1 79 : CHARACTER*(8) TYPE 80 : C 81 : C 82 : C**** KRIPAD pour la correspondance global/local 83 : C 83 : CALL KRIPAD(MELEMC,MLEMC) 84 : C SEGINI MLEMC 84 : CALL KRIPAD(MELECB,MLEMCB) 85 : C SEGINI MLEMCB 85 : CALL KRIPAD(MELEMF,MLEMF) 86 : C SEGINI MLEMF 87 : C 88 : C**** CHPOINTs de la table DOMAINE 89 : C 89 : CALL LICHT(INORM,MPNORM,TYPE,ICEL) 89 : CALL LICHT(ICHPVO,MPVOL,TYPE,ICEL) 89 : CALL LICHT(ICHPSU,MPSURF,TYPE,ICEL) 90 : C 91 : C**** LICHT active les MPOVALs en *MOD 92 : C 93 : C SEGACT MPNORM*MOD 94 : C SEGACT MPOVSU*MOD 95 : C SEGACT MPOVOL*MOD 96 : C 97 : C 98 : C**** CHPOINTs des variables 99 : C 99 : CALL LICHT(IROC,MPRC,TYPE,ICEL) 99 : CALL LICHT(IVITC,MPVC,TYPE,ICEL) 99 : CALL LICHT(IPC,MPPC,TYPE,ICEL) 99 : CALL LICHT(IGAMC,MPGAMC,TYPE,ICEL) 99 : CALL LICHT(ICHLIM,MPLIM,TYPE,ICEL) 100 : C 101 : C SEGACT *MOD 102 : C SEGACT *MOD 103 : C SEGACT *MOD 104 : C SEGACT *MOD 105 : C SEGACT *MOD 106 : C 107 : C 108 : C**** Boucle sur le face pour le calcul des invariants de 109 : C Riemann et du flux 110 : C 111 : SEGACT MELEFC 112 : NFAC=MELEFC.NUM(/2) 113 : C 114 : C**** Objet MATRIK 115 : C 116 : NRIGE = 7 117 : NMATRI = 1 118 : NKID = 9 119 : NKMT = 7 120 : C 121 : SEGINI MATRIK 122 : IJACO = MATRIK 123 : MATRIK.IRIGEL(1,1) = MELRES 124 : MATRIK.IRIGEL(2,1) = MELRES 125 : C 126 : C**** Matrice non symetrique 127 : C 128 : MATRIK.IRIGEL(7,1) = 2 129 : C 130 : NBME = 25 131 : NBSOUS = 1 132 : SEGINI IMATRI 133 : IF(IJAC.EQ.1)THEN 134 : MLMOTS=ILIINC 135 : ELSEIF(IJAC.EQ.2)THEN 136 : MLMOTS=ILIINP 137 : ENDIF 138 : SEGACT MLMOTS 139 : MATRIK.IRIGEL(4,1) = IMATRI 140 : C 141 : IMATRI.LISPRI(1) = MLMOTS.MOTS(1) 142 : IMATRI.LISPRI(2) = MLMOTS.MOTS(2) 143 : IMATRI.LISPRI(3) = MLMOTS.MOTS(3) 144 : IMATRI.LISPRI(4) = MLMOTS.MOTS(4) 145 : IMATRI.LISPRI(5) = MLMOTS.MOTS(5) 146 : C 147 : IMATRI.LISPRI(6) = MLMOTS.MOTS(1) 148 : IMATRI.LISPRI(7) = MLMOTS.MOTS(2) 149 : IMATRI.LISPRI(8) = MLMOTS.MOTS(3) 150 : IMATRI.LISPRI(9) = MLMOTS.MOTS(4) 151 : IMATRI.LISPRI(10) = MLMOTS.MOTS(5) 152 : C 153 : IMATRI.LISPRI(11) = MLMOTS.MOTS(1) 154 : IMATRI.LISPRI(12) = MLMOTS.MOTS(2) 155 : IMATRI.LISPRI(13) = MLMOTS.MOTS(3) 156 : IMATRI.LISPRI(14) = MLMOTS.MOTS(4) 157 : IMATRI.LISPRI(15) = MLMOTS.MOTS(5) 158 : C 159 : IMATRI.LISPRI(16) = MLMOTS.MOTS(1) 160 : IMATRI.LISPRI(17) = MLMOTS.MOTS(2) 161 : IMATRI.LISPRI(18) = MLMOTS.MOTS(3) 162 : IMATRI.LISPRI(19) = MLMOTS.MOTS(4) 163 : IMATRI.LISPRI(20) = MLMOTS.MOTS(5) 164 : C 165 : IMATRI.LISPRI(21) = MLMOTS.MOTS(1) 166 : IMATRI.LISPRI(22) = MLMOTS.MOTS(2) 167 : IMATRI.LISPRI(23) = MLMOTS.MOTS(3) 168 : IMATRI.LISPRI(24) = MLMOTS.MOTS(4) 169 : IMATRI.LISPRI(25) = MLMOTS.MOTS(5) 170 : C 171 : SEGDES MLMOTS 172 : MLMOTS=ILIINC 173 : SEGACT MLMOTS 174 : C 175 : C 176 : IMATRI.LISDUA(1) = MLMOTS.MOTS(1) 177 : IMATRI.LISDUA(2) = MLMOTS.MOTS(1) 178 : IMATRI.LISDUA(3) = MLMOTS.MOTS(1) 179 : IMATRI.LISDUA(4) = MLMOTS.MOTS(1) 180 : IMATRI.LISDUA(5) = MLMOTS.MOTS(1) 181 : C 182 : IMATRI.LISDUA(6) = MLMOTS.MOTS(2) 183 : IMATRI.LISDUA(7) = MLMOTS.MOTS(2) 184 : IMATRI.LISDUA(8) = MLMOTS.MOTS(2) 185 : IMATRI.LISDUA(9) = MLMOTS.MOTS(2) 186 : IMATRI.LISDUA(10) = MLMOTS.MOTS(2) 187 : C 188 : IMATRI.LISDUA(11) = MLMOTS.MOTS(3) 189 : IMATRI.LISDUA(12) = MLMOTS.MOTS(3) 190 : IMATRI.LISDUA(13) = MLMOTS.MOTS(3) 191 : IMATRI.LISDUA(14) = MLMOTS.MOTS(3) 192 : IMATRI.LISDUA(15) = MLMOTS.MOTS(3) 193 : C 194 : IMATRI.LISDUA(16) = MLMOTS.MOTS(4) 195 : IMATRI.LISDUA(17) = MLMOTS.MOTS(4) 196 : IMATRI.LISDUA(18) = MLMOTS.MOTS(4) 197 : IMATRI.LISDUA(19) = MLMOTS.MOTS(4) 198 : IMATRI.LISDUA(20) = MLMOTS.MOTS(4) 199 : C 200 : IMATRI.LISDUA(21) = MLMOTS.MOTS(5) 201 : IMATRI.LISDUA(22) = MLMOTS.MOTS(5) 202 : IMATRI.LISDUA(23) = MLMOTS.MOTS(5) 203 : IMATRI.LISDUA(24) = MLMOTS.MOTS(5) 204 : IMATRI.LISDUA(25) = MLMOTS.MOTS(5) 205 : C 206 : SEGDES MLMOTS 207 : NBEL = NFAC 208 : NBSOUS = 1 209 : NP = 1 210 : MP = 1 211 : SEGINI RR , RUX , RUY , RUZ ,RRET , 212 : & UXR , UXUX , UXUY , UXUZ ,UXRET , 213 : & UYR , UYUX , UYUY , UYUZ , UYRET , 214 : & UZR , UZUX , UZUY , UZUZ , UZRET , 215 : & RETR , RETUX , RETUY, RETUZ , RETRET 216 : C 217 : C**** Duale = IMATRI.LISDUA(1) = 'RN' 218 : C Primale = IMATRI.LISPRI(1) = 'RN' 219 : C -> IMATRI.LIZAFM(1,1) = RR 220 : C 221 : IMATRI.LIZAFM(1,1) = RR 222 : IMATRI.LIZAFM(1,2) = RUX 223 : IMATRI.LIZAFM(1,3) = RUY 224 : IMATRI.LIZAFM(1,4) = RUZ 225 : IMATRI.LIZAFM(1,5) = RRET 226 : C 227 : IMATRI.LIZAFM(1,6) = UXR 228 : IMATRI.LIZAFM(1,7) = UXUX 229 : IMATRI.LIZAFM(1,8) = UXUY 230 : IMATRI.LIZAFM(1,9) = UXUZ 231 : IMATRI.LIZAFM(1,10) = UXRET 232 : C 233 : IMATRI.LIZAFM(1,11) = UYR 234 : IMATRI.LIZAFM(1,12) = UYUX 235 : IMATRI.LIZAFM(1,13) = UYUY 236 : IMATRI.LIZAFM(1,14) = UYUZ 237 : IMATRI.LIZAFM(1,15) = UYRET 238 : C 239 : IMATRI.LIZAFM(1,16) = UZR 240 : IMATRI.LIZAFM(1,17) = UZUX 241 : IMATRI.LIZAFM(1,18) = UZUY 242 : IMATRI.LIZAFM(1,19) = UZUZ 243 : IMATRI.LIZAFM(1,20) = UZRET 244 : C 245 : IMATRI.LIZAFM(1,21) = RETR 246 : IMATRI.LIZAFM(1,22) = RETUX 247 : IMATRI.LIZAFM(1,23) = RETUY 248 : IMATRI.LIZAFM(1,24) = RETUZ 249 : IMATRI.LIZAFM(1,25) = RETRET 250 : C 251 : SEGDES MATRIK 252 : SEGDES IMATRI 253 : C 254 : C**** Fin definition MATRIK 255 : C 256 : DO IFAC=1,NFAC,1 257 : NGF=MELEFC.NUM(1,IFAC) 258 : NGC=MELEFC.NUM(2,IFAC) 259 : NLF=MLEMF.LECT(NGF) 260 : NLC=MLEMC.LECT(NGC) 261 : NLCB=MLEMCB.LECT(NGF) 262 : VOLU=MPVOL.VPOCHA(NLC,1) 263 : SURF=MPSURF.VPOCHA(NLF,1) 264 : C In CASTEM les normales sont sortantes 265 : CNX=-1*MPNORM.VPOCHA(NLF,1) 266 : CNY=-1*MPNORM.VPOCHA(NLF,2) 267 : CNZ=-1*MPNORM.VPOCHA(NLF,3) 268 : C Variables au centre 269 : RC=MPRC.VPOCHA(NLC,1) 270 : PC=MPPC.VPOCHA(NLC,1) 271 : UXC=MPVC.VPOCHA(NLC,1) 272 : UYC=MPVC.VPOCHA(NLC,2) 273 : UZC=MPVC.VPOCHA(NLC,3) 274 : GAMC=MPGAMC.VPOCHA(NLC,1) 275 : UNC=(UXC*CNX)+(UYC*CNY)+(UZC*CNZ) 276 : CC=GAMC*PC/RC 277 : CC=CC**0.5D0 278 : GM1=GAMC-1.0D0 279 : C Variables à la face 280 : RHOUF=MPLIM.VPOCHA(NLCB,1) 281 : PSRF=MPLIM.VPOCHA(NLCB,2) 282 : C 283 : C******* Variables à l'interface 284 : C 285 : ACEL=CC/GAMC 286 : BCEL=ACEL - UNC 287 : CCEL=(RHOUF / PC) * PSRF 288 : PSTAR=BCEL+(((BCEL*BCEL) + (4*ACEL*CCEL))**0.5D0) 289 : PSTAR=PSTAR/(2*ACEL) 290 : P=PSTAR*PC 291 : RHO=P/PSRF 292 : UN=RHOUF/RHO 293 : UX=UN*CNX 294 : UY=UN*CNY 295 : UZ=UN*CNZ 296 : ECIN=0.5D0*((UX*UX)+(UY*UY)+(UZ*UZ)) 297 : C 298 : C******* Derivatives of ACEL, BCEL, CCEL with respect to the 299 : C variables at centers 300 : C 301 : DADR = -0.5D0*CC/(RC*GAMC) 302 : DADP = 0.5D0*CC/(PC*GAMC) 303 : DBDR = DADR 304 : DBDP = DADP 305 : DBDUX = -1*CNX 306 : DBDUY = -1*CNY 307 : DBDUZ = -1*CNZ 308 : DCDP = -1*CCEL/PC 309 : C 310 : C******* Derivatives of PSTAR with respect to ACEL,BCEL,CCEL 311 : C 312 : DPSDA = -1*(PSTAR*PSTAR)/((2*ACEL*PSTAR)-BCEL) 313 : DPSDB = PSTAR/((2*ACEL*PSTAR)-BCEL) 314 : DPSDC = 1/((2*ACEL*PSTAR)-BCEL) 315 : C 316 : C******* Derivatives of PC*PSTAR with respect to RC,PC,UXC,UYC 317 : C 318 : DPDR=(DPSDA*DADR)+(DPSDB*DBDR) 319 : DPDR=DPDR*PC 320 : DPDP=(DPSDA*DADP)+(DPSDB*DBDP)+(DPSDC*DCDP) 321 : DPDP=(DPDP*PC)+PSTAR 322 : DPDUX=(DPSDB*DBDUX)*PC 323 : DPDUY=(DPSDB*DBDUY)*PC 324 : DPDUZ=(DPSDB*DBDUZ)*PC 325 : CC 326 : CC******* Test 1 327 : CC 328 : CC We check dpdp 329 : CC 330 : C YCAC=P 331 : C XCAC=PC 332 : C PC=PC*(1+1.0D-4) 333 : C CC=GAMC*PC/RC 334 : C CC=CC**0.5D0 335 : CC 336 : C ACEL=CC/GAMC 337 : C BCEL=ACEL - UNC 338 : C CCEL=(RHOUF / PC) * PSRF 339 : C PSTAR=BCEL+(((BCEL*BCEL) + (4*ACEL*CCEL))**0.5D0) 340 : C PSTAR=PSTAR/(2*ACEL) 341 : C P=PSTAR*PC 342 : C write(*,*) ((P - YCAC)/(PC - XCAC)), DPDP 343 : CC 344 : CC We check dpdr 345 : CC 346 : C YCAC=P 347 : C XCAC=RC 348 : C RC=RC*(1+1.0D-4) 349 : C CC=GAMC*PC/RC 350 : C CC=CC**0.5D0 351 : CC 352 : C ACEL=CC/GAMC 353 : C BCEL=ACEL - UNC 354 : C CCEL=(RHOUF / PC) * PSRF 355 : C PSTAR=BCEL+(((BCEL*BCEL) + (4*ACEL*CCEL))**0.5D0) 356 : C PSTAR=PSTAR/(2*ACEL) 357 : C P=PSTAR*PC 358 : C write(*,*) ((P - YCAC)/(RC - XCAC)), DPDR 359 : CC 360 : CC We check dpdux 361 : CC 362 : C YCAC=P 363 : C XCAC=UXC 364 : C UXC=UXC*(1+1.0D-4) 365 : C UNC=(UXC*CNX)+(UYC*CNY)+(UZC*CNZ) 366 : C CC=GAMC*PC/RC 367 : C CC=CC**0.5D0 368 : CC 369 : C ACEL=CC/GAMC 370 : C BCEL=ACEL - UNC 371 : C CCEL=(RHOUF / PC) * PSRF 372 : C PSTAR=BCEL+(((BCEL*BCEL) + (4*ACEL*CCEL))**0.5D0) 373 : C PSTAR=PSTAR/(2*ACEL) 374 : C P=PSTAR*PC 375 : C write(*,*) ((P - YCAC)/(UXC - XCAC)), DPDUX 376 : CC 377 : CC We check dpduy 378 : CC 379 : C YCAC=P 380 : C XCAC=UYC 381 : C UYC=UYC*(1+1.0D-4) 382 : C UNC=(UXC*CNX)+(UYC*CNY)+(UZC*CNZ) 383 : C CC=GAMC*PC/RC 384 : C CC=CC**0.5D0 385 : CC 386 : C ACEL=CC/GAMC 387 : C BCEL=ACEL - UNC 388 : C CCEL=(RHOUF / PC) * PSRF 389 : C PSTAR=BCEL+(((BCEL*BCEL) + (4*ACEL*CCEL))**0.5D0) 390 : C PSTAR=PSTAR/(2*ACEL) 391 : C P=PSTAR*PC 392 : C write(*,*) ((P - YCAC)/(UYC - XCAC)), DPDUY 393 : CC 394 : CC We check dpduz 395 : CC 396 : C YCAC=P 397 : C XCAC=UZC 398 : C UZC=UZC*(1+1.0D-4) 399 : C UNC=(UXC*CNX)+(UYC*CNY)+(UZC*CNZ) 400 : C CC=GAMC*PC/RC 401 : C CC=CC**0.5D0 402 : CC 403 : C ACEL=CC/GAMC 404 : C BCEL=ACEL - UNC 405 : C CCEL=(RHOUF / PC) * PSRF 406 : C PSTAR=BCEL+(((BCEL*BCEL) + (4*ACEL*CCEL))**0.5D0) 407 : C PSTAR=PSTAR/(2*ACEL) 408 : C P=PSTAR*PC 409 : C write(*,*) ((P - YCAC)/(UZC - XCAC)), DPDUZ 410 : CC 411 : CC 412 : CC******* Fin test 1 413 : C 414 : C 415 : C******* The interfacial state is thus given by 416 : C RHOUF,PSRF,P and UT (UT=0), UT2 (UT2=0) 417 : C Let us now compute the derivative of the residuum with 418 : C respect to P. 419 : C The residuum is given by 420 : C 421 : C F1=RHOUF*SURF/VOLU 422 : C F2=(RHOUF*UX+P*CNX)*SURF/VOLU 423 : C F3=(RHOUF*UY+P*CNY)*SURF/VOLU 424 : C F4=(RHOUF*UZ+P*CNZ)*SURF/VOLU 425 : C F5=(RHOUF*((GAMC*USGM1*PSRF)+ECIN))*SURF/VOLU 426 : C 427 : C In these expression: UX, UY, P and ECIN depends on P 428 : C 429 : COEF=SURF/VOLU 430 : DUXDP=-1*UX/P 431 : DUYDP=-1*UY/P 432 : DUZDP=-1*UZ/P 433 : DECINP=-2*ECIN/P 434 : DF2DP=((RHOUF*DUXDP)+CNX)*COEF 435 : DF3DP=((RHOUF*DUYDP)+CNY)*COEF 436 : DF4DP=((RHOUF*DUZDP)+CNZ)*COEF 437 : DF5DP=(RHOUF*DECINP)*COEF 438 : CC 439 : CC******* Test 2 440 : CC 441 : CC We check DF2P 442 : CC 443 : C USGM1=1/GM1 444 : C F2=(RHOUF*UX+P*CNX)*COEF 445 : C F3=(RHOUF*UY+P*CNY)*COEF 446 : C F4=(RHOUF*UZ+P*CNZ)*COEF 447 : C F5=(RHOUF*((GAMC*USGM1*PSRF)+ECIN))*COEF 448 : CC 449 : C YCAC=F2 450 : C YCAC2=F3 451 : C YCAC3=F4 452 : C YCAC4=F5 453 : C XCAC=P 454 : C P=P*(1+1.0D-4) 455 : C RHO=P/PSRF 456 : C UN=RHOUF/RHO 457 : C UX=UN*CNX 458 : C UY=UN*CNY 459 : C UZ=UN*CNZ 460 : C ECIN=0.5D0*((UX*UX)+(UY*UY)+(UZ*UZ)) 461 : C 462 : C F2=(RHOUF*UX+P*CNX)*COEF 463 : C F3=(RHOUF*UY+P*CNY)*COEF 464 : C F4=(RHOUF*UZ+P*CNZ)*COEF 465 : C F5=(RHOUF*((GAMC*USGM1*PSRF)+ECIN))*COEF 466 : C write(*,*) ((F2 -YCAC)/(P-XCAC)),DF2DP 467 : C write(*,*) ((F3 -YCAC2)/(P-XCAC)),DF3DP 468 : C write(*,*) ((F4 -YCAC3)/(P-XCAC)),DF4DP 469 : C write(*,*) ((F5 -YCAC4)/(P-XCAC)),DF5DP 470 : C 471 : C******* Fin test 2 472 : C 473 : C 474 : C******* Jacobian with respect to primitive variables 475 : C 476 : C 477 : C DF1D... 478 : C 479 : DRORO=0.0D0 480 : DROUX=0.0D0 481 : DROUY=0.0D0 482 : DROUZ=0.0D0 483 : DROP=0.0D0 484 : C 485 : C DF5D... 486 : C 487 : DPRO=DF5DP*DPDR 488 : DPUX=DF5DP*DPDUX 489 : DPUY=DF5DP*DPDUY 490 : DPUZ=DF5DP*DPDUZ 491 : DPP=DF5DP*DPDP 492 : C 493 : C DF2D... 494 : C 495 : DUXRO=DF2DP*DPDR 496 : DUXUX=DF2DP*DPDUX 497 : DUXUY=DF2DP*DPDUY 498 : DUXUZ=DF2DP*DPDUZ 499 : DUXP =DF2DP*DPDP 500 : C 501 : C DF3D 502 : C 503 : DUYRO=DF3DP*DPDR 504 : DUYUX=DF3DP*DPDUX 505 : DUYUY=DF3DP*DPDUY 506 : DUYUZ=DF3DP*DPDUZ 507 : DUYP =DF3DP*DPDP 508 : C 509 : C DF4D 510 : C 511 : DUZRO=DF4DP*DPDR 512 : DUZUX=DF4DP*DPDUX 513 : DUZUY=DF4DP*DPDUY 514 : DUZUZ=DF4DP*DPDUZ 515 : DUZP =DF4DP*DPDP 516 : C 517 : C******* Jacobian with respect to conservative variables 518 : C 519 : IF(IJAC.EQ.1)THEN 520 : GM1=GAMC-1.0D0 521 : C 522 : COEF1=-1.0D0*UXC/RC 523 : COEF2=-1.0D0*UYC/RC 524 : COEF3=-1.0D0*UZC/RC 525 : COEF4=0.5D0*GM1*((UXC*UXC)+(UYC*UYC)+(UZC*UZC)) 526 : C 527 : RR.AM(IFAC,1,1)=DRORO+(DROUX*COEF1)+(DROUY*COEF2)+(DROUZ 528 : $ *COEF3)+(DROP*COEF4) 529 : RUX.AM(IFAC,1,1)=(DROUX/RC)-((UXC*GM1)*DROP) 530 : RUY.AM(IFAC,1,1)=(DROUY/RC)-((UYC*GM1)*DROP) 531 : RUZ.AM(IFAC,1,1)=(DROUZ/RC)-((UZC*GM1)*DROP) 532 : RRET.AM(IFAC,1,1)=GM1*DROP 533 : C 534 : UXR.AM(IFAC,1,1)=DUXRO+(DUXUX*COEF1)+(DUXUY*COEF2)+(DUXUZ 535 : $ *COEF3)+(DUXP*COEF4) 536 : UXUX.AM(IFAC,1,1)=(DUXUX/RC)-((UXC*GM1)*DUXP) 537 : UXUY.AM(IFAC,1,1)=(DUXUY/RC)-((UYC*GM1)*DUXP) 538 : UXUZ.AM(IFAC,1,1)=(DUXUZ/RC)-((UZC*GM1)*DUXP) 539 : UXRET.AM(IFAC,1,1)=GM1*DUXP 540 : C 541 : UYR.AM(IFAC,1,1)=DUYRO+(DUYUX*COEF1)+(DUYUY*COEF2)+(DUYUZ 542 : $ *COEF3)+(DUYP*COEF4) 543 : UYUX.AM(IFAC,1,1)=(DUYUX/RC)-((UXC*GM1)*DUYP) 544 : UYUY.AM(IFAC,1,1)=(DUYUY/RC)-((UYC*GM1)*DUYP) 545 : UYUZ.AM(IFAC,1,1)=(DUYUZ/RC)-((UZC*GM1)*DUYP) 546 : UYRET.AM(IFAC,1,1)=GM1*DUYP 547 : C 548 : UZR.AM(IFAC,1,1)=DUZRO+(DUZUX*COEF1)+(DUZUY*COEF2)+(DUZUZ 549 : $ *COEF3)+(DUZP*COEF4) 550 : UZUX.AM(IFAC,1,1)=(DUZUX/RC)-((UXC*GM1)*DUZP) 551 : UZUY.AM(IFAC,1,1)=(DUZUY/RC)-((UYC*GM1)*DUZP) 552 : UZUZ.AM(IFAC,1,1)=(DUZUZ/RC)-((UZC*GM1)*DUZP) 553 : UZRET.AM(IFAC,1,1)=GM1*DUZP 554 : C 555 : RETR.AM(IFAC,1,1)=DPRO+(DPUX*COEF1)+(DPUY*COEF2)+(DPUZ 556 : $ *COEF3)+(DPP*COEF4) 557 : RETUX.AM(IFAC,1,1)=(DPUX/RC)-((UXC*GM1)*DPP) 558 : RETUY.AM(IFAC,1,1)=(DPUY/RC)-((UYC*GM1)*DPP) 559 : RETUZ.AM(IFAC,1,1)=(DPUZ/RC)-((UZC*GM1)*DPP) 560 : RETRET.AM(IFAC,1,1)=GM1*DPP 561 : C 562 : ELSEIF(IJAC.EQ.2)THEN 563 : RR.AM(IFAC,1,1)=DRORO 564 : RUX.AM(IFAC,1,1)=DROUX 565 : RUY.AM(IFAC,1,1)=DROUY 566 : RUZ.AM(IFAC,1,1)=DROUZ 567 : RRET.AM(IFAC,1,1)=DROP 568 : C 569 : UXR.AM(IFAC,1,1)=DUXRO 570 : UXUX.AM(IFAC,1,1)=DUXUX 571 : UXUY.AM(IFAC,1,1)=DUXUY 572 : UXUZ.AM(IFAC,1,1)=DUXUZ 573 : UXRET.AM(IFAC,1,1)=DUXP 574 : C 575 : UYR.AM(IFAC,1,1)=DUYRO 576 : UYUX.AM(IFAC,1,1)=DUYUX 577 : UYUY.AM(IFAC,1,1)=DUYUY 578 : UYUZ.AM(IFAC,1,1)=DUYUZ 579 : UYRET.AM(IFAC,1,1)=DUYP 580 : C 581 : UZR.AM(IFAC,1,1)=DUZRO 582 : UZUX.AM(IFAC,1,1)=DUZUX 583 : UZUY.AM(IFAC,1,1)=DUZUY 584 : UZUZ.AM(IFAC,1,1)=DUZUZ 585 : UZRET.AM(IFAC,1,1)=DUZP 586 : C 587 : RETR.AM(IFAC,1,1)=DPRO 588 : RETUX.AM(IFAC,1,1)=DPUX 589 : RETUY.AM(IFAC,1,1)=DPUY 590 : RETUZ.AM(IFAC,1,1)=DPUZ 591 : RETRET.AM(IFAC,1,1)=DPP 592 : ENDIF 593 : ENDDO 594 : C 595 : SEGDES MELEFC 596 : C 597 : SEGSUP MLEMC 598 : SEGSUP MLEMCB 599 : SEGSUP MLEMF 600 : C 601 : SEGDES MPNORM 602 : SEGDES MPVOL 603 : SEGDES MPSURF 604 : SEGDES MPRC 605 : SEGDES MPPC 606 : SEGDES MPVC 607 : SEGDES MPGAMC 608 : SEGDES MPLIM 609 : C 610 : SEGDES RR , RUX , RUY , RUZ ,RRET , 611 : & UXR , UXUX , UXUY , UXUZ ,UXRET , 612 : & UYR , UYUX , UYUY , UYUZ , UYRET , 613 : & UZR , UZUX , UZUY , UZUZ , UZRET , 614 : & RETR , RETUX , RETUY, RETUZ , RETRET 615 : C 616 : 9999 CONTINUE 617 : RETURN 618 : END 619 : 620 : 621 : 622 : 623 : 624 : 625 : 626 : 627 : 628 :
© Cast3M 2003 - All rights reserved.
Disclaimer