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