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