1 : C CLI142 SOURCE MAGN 09/07/30 21:15:42 6458 2 : SUBROUTINE CLI142(MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM,ICHPVO, 3 : & ICHPSU,IROC,IVITC,IPC,IGAMC,ILIINC,ILIINP,IJAC,IJACO) 4 : C************************************************************************ 5 : C 6 : C PROJET : CASTEM 2000 7 : C 8 : C NOM : CLI122 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 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,ICEL,NFAC,IFAC,MELRES,IJACO 59 : & ,NGF,NGC,NLF,NLC 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 63 : & ,UNC 64 : & ,GM1,USGM1,COEF,ECIN,HIN 65 : & ,DRORO,DROUX,DROUY,DROP 66 : & ,DUXRO,DUXUX,DUXUY,DUXP 67 : & ,DUYRO,DUYUX,DUYUY,DUYP 68 : & ,DPRO,DPUX,DPUY,DPP 69 : & ,COEF1,COEF2,COEF3 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) 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 : VOLU=MPVOL.VPOCHA(NLC,1) 212 : SURF=MPSURF.VPOCHA(NLF,1) 213 : C In CASTEM les normales sont sortantes 214 : CNX=MPNORM.VPOCHA(NLF,1) 215 : CNY=MPNORM.VPOCHA(NLF,2) 216 : C Variables au centre 217 : RC=MPRC.VPOCHA(NLC,1) 218 : PC=MPPC.VPOCHA(NLC,1) 219 : UXC=MPVC.VPOCHA(NLC,1) 220 : UYC=MPVC.VPOCHA(NLC,2) 221 : GAMC=MPGAMC.VPOCHA(NLC,1) 222 : GM1=GAMC-1.0D0 223 : USGM1=1.0D0/GM1 224 : C 225 : C******* On calcule UN, UT 226 : C 227 : UNC=(UXC*CNX)+(UYC*CNY) 228 : C 229 : C******* Densite, vitesse, pression sur le bord 230 : C 231 : COEF=-1*SURF/VOLU 232 : C 233 : DRORO=UNC*COEF 234 : DROUX=(RC*CNX)*COEF 235 : DROUY=(RC*CNY)*COEF 236 : DROP=0.0D0 237 : C 238 : DUXRO=(UNC*UXC)*COEF 239 : DUXUX=((RC*CNX*UXC)+(RC*UNC))*COEF 240 : DUXUY=((RC*CNY*UXC))*COEF 241 : DUXP=CNX*COEF 242 : C 243 : DUYRO=(UNC*UYC)*COEF 244 : DUYUX=((RC*CNX*UYC))*COEF 245 : DUYUY=((RC*CNY*UYC)+(RC*UNC))*COEF 246 : DUYP=CNY*COEF 247 : C 248 : ECIN=0.5D0*((UXC*UXC)+(UYC*UYC)) 249 : HIN=GAMC*USGM1*PC 250 : DPRO=(UNC*ECIN)*COEF 251 : DPUX=((CNX*HIN)+(RC*CNX*ECIN)+(RC*UNC*UXC))*COEF 252 : DPUY=((CNY*HIN)+(RC*CNY*ECIN)+(RC*UNC*UYC))*COEF 253 : DPP=(UNC*GAMC*USGM1)*COEF 254 : CC 255 : CC******* Jacobian with respect to conservative variables 256 : CC 257 : IF(IJAC.EQ.1)THEN 258 : 259 : COEF1=-1.0D0*UXC/RC 260 : COEF2=-1.0D0*UYC/RC 261 : COEF3=0.5D0*GM1*((UXC*UXC)+(UYC*UYC)) 262 : C 263 : RR.AM(IFAC,1,1)=DRORO+(DROUX*COEF1)+(DROUY*COEF2)+(DROP 264 : $ *COEF3) 265 : RUX.AM(IFAC,1,1)=(DROUX/RC)-((UXC*GM1)*DROP) 266 : RUY.AM(IFAC,1,1)=(DROUY/RC)-((UYC*GM1)*DROP) 267 : RRET.AM(IFAC,1,1)=GM1*DROP 268 : C 269 : UXR.AM(IFAC,1,1)=DUXRO+(DUXUX*COEF1)+(DUXUY*COEF2)+(DUXP 270 : $ *COEF3) 271 : UXUX.AM(IFAC,1,1)=(DUXUX/RC)-((UXC*GM1)*DUXP) 272 : UXUY.AM(IFAC,1,1)=(DUXUY/RC)-((UYC*GM1)*DUXP) 273 : UXRET.AM(IFAC,1,1)=GM1*DUXP 274 : C 275 : UYR.AM(IFAC,1,1)=DUYRO+(DUYUX*COEF1)+(DUYUY*COEF2)+(DUYP 276 : $ *COEF3) 277 : UYUX.AM(IFAC,1,1)=(DUYUX/RC)-((UXC*GM1)*DUYP) 278 : UYUY.AM(IFAC,1,1)=(DUYUY/RC)-((UYC*GM1)*DUYP) 279 : UYRET.AM(IFAC,1,1)=GM1*DUYP 280 : C 281 : RETR.AM(IFAC,1,1)=DPRO+(DPUX*COEF1)+(DPUY*COEF2)+(DPP 282 : $ *COEF3) 283 : RETUX.AM(IFAC,1,1)=(DPUX/RC)-((UXC*GM1)*DPP) 284 : RETUY.AM(IFAC,1,1)=(DPUY/RC)-((UYC*GM1)*DPP) 285 : RETRET.AM(IFAC,1,1)=GM1*DPP 286 : C 287 : ELSEIF(IJAC.EQ.2)THEN 288 : RR.AM(IFAC,1,1)=DRORO 289 : RUX.AM(IFAC,1,1)=DROUX 290 : RUY.AM(IFAC,1,1)=DROUY 291 : RRET.AM(IFAC,1,1)=DROP 292 : C 293 : UXR.AM(IFAC,1,1)=DUXRO 294 : UXUX.AM(IFAC,1,1)=DUXUX 295 : UXUY.AM(IFAC,1,1)=DUXUY 296 : UXRET.AM(IFAC,1,1)=DUXP 297 : C 298 : UYR.AM(IFAC,1,1)=DUYRO 299 : UYUX.AM(IFAC,1,1)=DUYUX 300 : UYUY.AM(IFAC,1,1)=DUYUY 301 : UYRET.AM(IFAC,1,1)=DUYP 302 : C 303 : RETR.AM(IFAC,1,1)=DPRO 304 : RETUX.AM(IFAC,1,1)=DPUX 305 : RETUY.AM(IFAC,1,1)=DPUY 306 : RETRET.AM(IFAC,1,1)=DPP 307 : ENDIF 308 : ENDDO 309 : C 310 : SEGDES MELEFC 311 : C 312 : SEGSUP MLEMC 313 : SEGSUP MLEMCB 314 : SEGSUP MLEMF 315 : C 316 : SEGDES MPNORM 317 : SEGDES MPVOL 318 : SEGDES MPSURF 319 : SEGDES MPRC 320 : SEGDES MPPC 321 : SEGDES MPVC 322 : SEGDES MPGAMC 323 : C 324 : SEGDES RR , RUX , RUY , RRET , 325 : & UXR , UXUX , UXUY , UXRET , 326 : & UYR , UYUX , UYUY , UYRET , 327 : & RETR , RETUX , RETUY , RETRET 328 : C 329 : 9999 CONTINUE 330 : RETURN 331 : END 332 : 333 : 334 : 335 : 336 : 337 : 338 : 339 : 340 :
© Cast3M 2003 - All rights reserved.
Disclaimer