1 : C CLI261 SOURCE CHAT 05/01/12 22:07:24 5004 2 : SUBROUTINE CLI261(NSP,MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO, 3 : & ICHPSU,LRECP,LRECV,IROC,IVITC,IPC,IYN,ICHLIM,ICHRES,ICHRLI) 4 : C************************************************************************ 5 : C 6 : C PROJET : CASTEM 2000 7 : C 8 : C NOM : CLI261 9 : C 10 : C DESCRIPTION : Subroutine appellée par CLIM22 11 : C calcul de RESIDU et CLIM at the board 12 : C OPTION: 'INSU' 2D 13 : C 14 : C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI) 15 : C 16 : C AUTEUR : S.Kudriakov, DEN/DM2S/SFME/LTMF 17 : C 18 : C************************************************************************ 19 : C 20 : C APPELES (Calcul) : 21 : C 22 : C************************************************************************ 23 : C 24 : C HISTORIQUE (Anomalies et modifications éventuelles) 25 : C 26 : C HISTORIQUE : 27 : C 28 : C************************************************************************ 29 : C 30 : IMPLICIT INTEGER(I-N) 31 : -INC CCOPTIO 32 : -INC SMLMOTS 33 : -INC SMELEME 34 : POINTEUR MELEFC.MELEME 35 : -INC SMLENTI 36 : POINTEUR MLEMC.MLENTI, MLEMCB.MLENTI,MLEMF.MLENTI 37 : -INC SMCHPOI 38 : POINTEUR MPNORM.MPOVAL, MPVOL.MPOVAL, MPSURF.MPOVAL, MPRC.MPOVAL, 39 : & MPVC.MPOVAL, MPPC.MPOVAL, MPYN.MPOVAL, MPLIM.MPOVAL, 40 : & MPRES.MPOVAL, MPRLI.MPOVAL 41 : C---------------------------------------- 42 : C**** Variables de COOPTIO 43 : C---------------------------------------- 44 : C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR 45 : C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ 46 : C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES 47 : C & ,IECHO, IIMPI, IOSPI 48 : C & ,IDIM, IFICLE, IPREFI 49 : C & ,MCOORD 50 : C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE 51 : C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU 52 : C & ,NORINC,NORVAL,NORIND,NORVAD 53 : C & ,NUCROU, IPSAUV 54 : C 55 : INTEGER MELEMF,MELEMC,MELECB,INORM,ICHPVO,ICHPSU, IROC,IVITC,IPC 56 : & ,IYN,ICHLIM,ICHRES,ICHRLI,ICEL,NFAC,IFAC 57 : & ,NGF,NGC,NLF,NLC,NLCB,LRECP,LRECV,I,NSP,NESP 58 : REAL*8 VOLU,SURF,RC,PC,UXC,UYC,UZC,GAMC,CNX,CNY,CNZ,CTX,CTY,CTZ 59 : & ,CT2X,CT2Y,CT2Z,RF,PF,UXF,UYF,UZF,TOP,BOT 60 : & ,UNC,UNF,UTF,UT2F,SF,GAMF,ECIN,PSRF,HTF,GM1 61 : & ,CELLT,UT2C,UTC 62 : CHARACTER*(8) TYPE 63 : C------------------------------------------------------------ 64 : -INC SMLREEL 65 : POINTEUR MLRECP.MLREEL, MLRECV.MLREEL 66 : C------------------------------------------------------- 67 : C********** Les CP's and CV's *********************** 68 : C------------------------------------------------------- 69 : SEGMENT GCONST 70 : REAL*8 GC(NSP) 71 : ENDSEGMENT 72 : POINTEUR CP.GCONST, CV.GCONST 73 : C------------------------------------------------------------- 74 : C******* Les fractionines massiques ************************** 75 : C------------------------------------------------------------- 76 : SEGMENT FRAMAS 77 : REAL*8 YET(NSP) 78 : ENDSEGMENT 79 : POINTEUR YC.FRAMAS, YF.FRAMAS 80 : C------------------------------------------------------------- 81 : C********** Segments for the flux-vector ******************* 82 : C------------------------------------------------------------- 83 : SEGMENT FUNEL 84 : REAL*8 FU(4+NSP) 85 : ENDSEGMENT 86 : POINTEUR flux2D.funel, flux3D.funel 87 : SEGINI FLUX2D 88 : SEGINI FLUX3D 89 : C------------------------------------------------------ 90 : C**** KRIPAD pour la correspondance global/local 91 : C------------------------------------------------------ 91 : CALL KRIPAD(MELEMC,MLEMC) 91 : CALL KRIPAD(MELECB,MLEMCB) 91 : CALL KRIPAD(MELEMF,MLEMF) 92 : C------------------------------------------------------ 93 : C**** CHPOINTs de la table DOMAINE 94 : C------------------------------------------------------ 94 : CALL LICHT(INORM,MPNORM,TYPE,ICEL) 94 : CALL LICHT(ICHPVO,MPVOL,TYPE,ICEL) 94 : CALL LICHT(ICHPSU,MPSURF,TYPE,ICEL) 95 : C------------------------------------------------------ 96 : C**** CHPOINTs des variables 97 : C------------------------------------------------------ 97 : CALL LICHT(IROC,MPRC,TYPE,ICEL) 97 : CALL LICHT(IVITC,MPVC,TYPE,ICEL) 97 : CALL LICHT(IPC,MPPC,TYPE,ICEL) 97 : CALL LICHT(IYN,MPYN,TYPE,ICEL) 97 : CALL LICHT(ICHLIM,MPLIM,TYPE,ICEL) 97 : CALL LICHT(ICHRES,MPRES,TYPE,ICEL) 97 : CALL LICHT(ICHRLI,MPRLI,TYPE,ICEL) 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 : UZC=0.0D0 105 : UZF=0.0D0 106 : UT2F=0.0D0 107 : CNZ=0.0D0 108 : CTZ=0.0D0 109 : CT2X=0.0D0 110 : CT2Y=0.0D0 111 : CT2Z=0.0D0 112 : DO 1 IFAC=1,NFAC,1 113 : NGF=MELEFC.NUM(1,IFAC) 114 : NGC=MELEFC.NUM(2,IFAC) 115 : NLF=MLEMF.LECT(NGF) 116 : NLC=MLEMC.LECT(NGC) 117 : NLCB=MLEMCB.LECT(NGF) 118 : VOLU=MPVOL.VPOCHA(NLC,1) 119 : SURF=MPSURF.VPOCHA(NLF,1) 120 : C---------------------------------------------- 121 : C In CASTEM les normales sont sortantes 122 : C---------------------------------------------- 123 : CNX=-1*MPNORM.VPOCHA(NLF,1) 124 : CNY=-1*MPNORM.VPOCHA(NLF,2) 125 : IF(IDIM.EQ.2)THEN 126 : CTX=-1.0D0*CNY 127 : CTY=CNX 128 : ELSE 129 : CNZ=-1*MPNORM.VPOCHA(NLF,3) 130 : CTX=-1*MPNORM.VPOCHA(NLF,4) 131 : CTY=-1*MPNORM.VPOCHA(NLF,5) 132 : CTZ=-1*MPNORM.VPOCHA(NLF,6) 133 : CT2X=-1*MPNORM.VPOCHA(NLF,7) 134 : CT2Y=-1*MPNORM.VPOCHA(NLF,8) 135 : CT2Z=-1*MPNORM.VPOCHA(NLF,9) 136 : ENDIF 137 : C---------------------------------------- 138 : SEGINI CP, CV 139 : MLRECP = LRECP 140 : MLRECV = LRECV 141 : SEGACT MLRECP, MLRECV 142 : DO 10 I=1,(NSP-1) 143 : CP.GC(I)=MLRECP.PROG(I) 144 : CV.GC(I)=MLRECV.PROG(I) 145 : 10 CONTINUE 146 : CP.GC(NSP)=MLRECP.PROG(NSP) 147 : CV.GC(NSP)=MLRECV.PROG(NSP) 148 : C---------------------------- 149 : C Variables au centre 150 : C---------------------------- 151 : RC=MPRC.VPOCHA(NLC,1) 152 : PC=MPPC.VPOCHA(NLC,1) 153 : UXC=MPVC.VPOCHA(NLC,1) 154 : UYC=MPVC.VPOCHA(NLC,2) 155 : IF(IDIM.EQ.3)UZC=MPVC.VPOCHA(NLC,3) 156 : SEGINI YC 157 : SEGACT MPYN 158 : DO 100 I=1,(NSP-1) 159 : YC.YET(I)=MPYN.VPOCHA(NLC,I) 160 : 100 CONTINUE 161 : C---------------------------- 162 : C Variables à la face 163 : C---------------------------- 164 : HTF=MPLIM.VPOCHA(NLCB,1) 165 : SF=MPLIM.VPOCHA(NLCB,2) 166 : SEGINI YF 167 : DO 101 I=1,(NSP-1) 168 : YF.YET(I)=MPLIM.VPOCHA(NLCB,2+I) 169 : 101 CONTINUE 170 : UTF=0.0D0 171 : c------------------------------------------------------------- 172 : c Computing GAMMA at the cell-center 173 : c------------------------------------------------------------- 174 : top=0.0D0 175 : bot=0.0D0 176 : do 102 i=1,(nsp-1) 177 : top=top+yc.yet(i)*(cp.gc(i)-cp.gc(nsp)) 178 : bot=bot+yc.yet(i)*(cv.gc(i)-cv.gc(nsp)) 179 : 102 continue 180 : top=cp.gc(nsp)+top 181 : bot=cv.gc(nsp)+bot 182 : GAMC=top/bot 183 : c------------------------------------------------------------- 184 : c Computing GAMMA at the face-center 185 : c------------------------------------------------------------- 186 : top=0.0D0 187 : bot=0.0D0 188 : do 103 i=1,(nsp-1) 189 : top=top+yf.yet(i)*(cp.gc(i)-cp.gc(nsp)) 190 : bot=bot+yf.yet(i)*(cv.gc(i)-cv.gc(nsp)) 191 : 103 continue 192 : top=cp.gc(nsp)+top 193 : bot=cv.gc(nsp)+bot 194 : GAMF=top/bot 195 : GM1=GAMF-1.0D0 196 : C--------------------------------------- 197 : C******* On calcule UN, UT, UT2, ASON, S 198 : C--------------------------------------- 199 : UNC=(UXC*CNX)+(UYC*CNY)+(UZC*CNZ) 200 : UNF=UNC 201 : UTC=(UXC*CTX)+(UYC*CTY)+(UZC*CTZ) 202 : C---------------------------------- 203 : UXF=UNF*CNX+UTF*CTX+UT2F*CT2X 204 : UYF=UNF*CNY+UTF*CTY+UT2F*CT2Y 205 : UZF=UNF*CNZ+UTF*CTZ+UT2F*CT2Z 206 : C---------------------------------- 207 : ECIN=0.5D0*((UXF*UXF)+(UYF*UYF)+(UZF*UZF)) 208 : PSRF=(GM1/GAMF)*(HTF-ECIN) 209 : RF=PSRF/SF 210 : RF=RF**(1.0D0/GM1) 211 : PF=SF*(RF**GAMF) 212 : C----------------------------------------------- 213 : C******* Densite, vitesse, pression sur le bord 214 : C----------------------------------------------- 215 : MPRLI.VPOCHA(NLCB,1)=RF 216 : MPRLI.VPOCHA(NLCB,2)=UXF 217 : MPRLI.VPOCHA(NLCB,3)=UYF 218 : IF(IDIM.EQ.3) MPRLI.VPOCHA(NLCB,4)=UZF 219 : MPRLI.VPOCHA(NLCB,IDIM+2)=PF 220 : do 104 i=1,(nsp-1) 221 : MPRLI.VPOCHA(NLCB,IDIM+2+I)=YF.YET(I) 222 : 104 continue 223 : C--------------------------------------------------- 224 : C******* Probleme de Riemann entre l'etat gauche 225 : C RF,UNC,UTF,UT2F,PF et l'etat droite 226 : C RC,UNC,UTC,UT2C,PC 227 : C On utilise AUSM+ 228 : C Flux dans le repaire normale 229 : C--------------------------------------------------- 230 : NESP=NSP-1 231 : IF(IDIM.EQ.2)THEN 231 : CALL FAUSMP(NESP, 232 : & GAMF,RF,PF,UNC,UTF, 233 : & GAMC,RC,PC,UNC,UTC, 234 : & YF.YET,YC.YET, 235 : & FLUX2D.FU, 236 : & CELLT) 237 : C------------------------------------------------------- 238 : C******* Residuum (son SPG a le meme ordre que MELEFC) 239 : C------------------------------------------------------- 240 : MPRES.VPOCHA(IFAC,1)=FLUX2D.FU(1)*SURF/VOLU 241 : MPRES.VPOCHA(IFAC,2)=((FLUX2D.FU(2)*CNX)+(FLUX2D.FU(3)*CTX)) 242 : & *SURF/VOLU 243 : MPRES.VPOCHA(IFAC,3)=((FLUX2D.FU(2)*CNY)+(FLUX2D.FU(3)*CTY)) 244 : & *SURF/VOLU 245 : MPRES.VPOCHA(IFAC,4)=FLUX2D.FU(4)*SURF/VOLU 246 : do 105 i=1,(nsp-1) 247 : MPRES.VPOCHA(IFAC,4+I)=FLUX2D.FU(4+I)*SURF/VOLU 248 : 105 continue 249 : ELSE 249 : CALL FAUSM3(NESP, 250 : & GAMF,RF,PF,UNC,UTF,UT2F, 251 : & GAMC,RC,PC,UNC,UTC,UT2C, 252 : & YF.YET,YC.YET, 253 : & FLUX3D.FU, 254 : & CELLT) 255 : C------------------------------------------------------ 256 : C******* Residuum (son SPG a le meme ordre que MELEFC) 257 : C------------------------------------------------------ 258 : MPRES.VPOCHA(IFAC,1)=FLUX3D.FU(1)*SURF/VOLU 259 : MPRES.VPOCHA(IFAC,2)=((FLUX3D.FU(2)*CNX)+(FLUX3D.FU(3)*CTX)+ 260 : & (FLUX3D.FU(4)*CT2X))*SURF/VOLU 261 : MPRES.VPOCHA(IFAC,3)=((FLUX3D.FU(2)*CNY)+(FLUX3D.FU(3)*CTY)+ 262 : & (FLUX3D.FU(4)*CT2Z))*SURF/VOLU 263 : MPRES.VPOCHA(IFAC,4)=((FLUX3D.FU(2)*CNZ)+(FLUX3D.FU(3)*CTZ)+ 264 : & (FLUX3D.FU(4)*CT2Z))*SURF/VOLU 265 : MPRES.VPOCHA(IFAC,5)=FLUX3D.FU(5)*SURF/VOLU 266 : do 106 i=1,(nsp-1) 267 : MPRES.VPOCHA(IFAC,5+I)=FLUX3D.FU(5+I)*SURF/VOLU 268 : 106 continue 269 : ENDIF 270 : 1 CONTINUE 271 : C 272 : SEGDES MELEFC 273 : C 274 : c SEGSUP MLEMC 275 : c SEGSUP MLEMCB 276 : c SEGSUP MLEMF 277 : c------------------------- 278 : SEGDES MLEMC 279 : SEGDES MLEMCB 280 : SEGDES MLEMF 281 : C 282 : SEGDES MPNORM 283 : SEGDES MPVOL 284 : SEGDES MPSURF 285 : SEGDES MPRC 286 : SEGDES MPPC 287 : SEGDES MPVC 288 : SEGDES MPYN 289 : SEGDES MPLIM 290 : SEGDES MPRES 291 : SEGDES MPRLI 292 : SEGDES MLRECP 293 : SEGDES MLRECV 294 : SEGDES YC 295 : SEGDES YF 296 : SEGDES FLUX2D 297 : SEGDES FLUX3D 298 : C 299 : 9999 CONTINUE 300 : RETURN 301 : END 302 : 303 : 304 : 305 : 306 : 307 : 308 : 309 : 310 : 311 :
© Cast3M 2003 - All rights reserved.
Disclaimer