1 : C CLI222 SOURCE CHAT 05/01/12 22:07:04 5004 2 : SUBROUTINE CLI222(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 : CLI222 9 : C 10 : C DESCRIPTION : Subroutine appellée par CLIM22 11 : C 12 : C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI) 13 : C 14 : C AUTEUR : S.Kudriakov, 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, MPYN.MPOVAL, MPLIM.MPOVAL, 38 : & MPRES.MPOVAL, MPRLI.MPOVAL 39 : C---------------------------------------- 40 : C**** Variables de COOPTIO 41 : C---------------------------------------- 42 : C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR 43 : C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ 44 : C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES 45 : C & ,IECHO, IIMPI, IOSPI 46 : C & ,IDIM, IFICLE, IPREFI 47 : C & ,MCOORD 48 : C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE 49 : C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU 50 : C & ,NORINC,NORVAL,NORIND,NORVAD 51 : C & ,NUCROU, IPSAUV 52 : C 53 : INTEGER MELEMF,MELEMC,MELECB,INORM,ICHPVO,ICHPSU, IROC,IVITC,IPC 54 : & ,IYN,ICHLIM,ICHRES,ICHRLI,ICEL,NFAC,IFAC 55 : & ,NGF,NGC,NLF,NLC,NLCB,LRECP,LRECV,I,NSP 56 : REAL*8 VOLU,SURF,RC,PC,UXC,UYC,UZC,GAMC,CNX,CNY,CNZ,CTX,CTY,CTZ 57 : & ,CT2X,CT2Y,CT2Z,RF,PF,UXF,UYF,UZF,TOP,BOT 58 : & ,UNC,UNF,UTC,UT2C,SC,ASONC,ASONF,GAMF,GAMM 59 : & ,G1,G3,ASON2,S,UT,UT2,UN,RHO,P,UX,UY,UZ 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, YF.FRAMAS 78 : C------------------------------------------------------ 79 : C**** KRIPAD pour la correspondance global/local 80 : C------------------------------------------------------ 80 : CALL KRIPAD(MELEMC,MLEMC) 80 : CALL KRIPAD(MELECB,MLEMCB) 80 : CALL KRIPAD(MELEMF,MLEMF) 81 : C------------------------------------------------------ 82 : C**** CHPOINTs de la table DOMAINE 83 : C------------------------------------------------------ 83 : CALL LICHT(INORM,MPNORM,TYPE,ICEL) 83 : CALL LICHT(ICHPVO,MPVOL,TYPE,ICEL) 83 : CALL LICHT(ICHPSU,MPSURF,TYPE,ICEL) 84 : C------------------------------------------------------ 85 : C**** CHPOINTs des variables 86 : C------------------------------------------------------ 86 : CALL LICHT(IROC,MPRC,TYPE,ICEL) 86 : CALL LICHT(IVITC,MPVC,TYPE,ICEL) 86 : CALL LICHT(IPC,MPPC,TYPE,ICEL) 86 : CALL LICHT(IYN,MPYN,TYPE,ICEL) 86 : CALL LICHT(ICHLIM,MPLIM,TYPE,ICEL) 86 : CALL LICHT(ICHRES,MPRES,TYPE,ICEL) 86 : CALL LICHT(ICHRLI,MPRLI,TYPE,ICEL) 87 : C--------------------------------------------------------- 88 : C**** Boucle sur le face pour le calcul des invariants de 89 : C Riemann et du flux 90 : C--------------------------------------------------------- 91 : SEGACT MELEFC 92 : NFAC=MELEFC.NUM(/2) 93 : UZC=0.0D0 94 : UZF=0.0D0 95 : CNZ=0.0D0 96 : CTZ=0.0D0 97 : CT2X=0.0D0 98 : CT2Y=0.0D0 99 : CT2Z=0.0D0 100 : DO 1 IFAC=1,NFAC,1 101 : NGF=MELEFC.NUM(1,IFAC) 102 : NGC=MELEFC.NUM(2,IFAC) 103 : NLF=MLEMF.LECT(NGF) 104 : NLC=MLEMC.LECT(NGC) 105 : NLCB=MLEMCB.LECT(NGF) 106 : VOLU=MPVOL.VPOCHA(NLC,1) 107 : SURF=MPSURF.VPOCHA(NLF,1) 108 : C---------------------------------------------- 109 : C In CASTEM les normales sont sortantes 110 : C---------------------------------------------- 111 : CNX=MPNORM.VPOCHA(NLF,1) 112 : CNY=MPNORM.VPOCHA(NLF,2) 113 : IF(IDIM.EQ.2)THEN 114 : CTX=-1.0D0*CNY 115 : CTY=CNX 116 : ELSE 117 : CNZ=MPNORM.VPOCHA(NLF,3) 118 : CTX=MPNORM.VPOCHA(NLF,4) 119 : CTY=MPNORM.VPOCHA(NLF,5) 120 : CTZ=MPNORM.VPOCHA(NLF,6) 121 : CT2X=MPNORM.VPOCHA(NLF,7) 122 : CT2Y=MPNORM.VPOCHA(NLF,8) 123 : CT2Z=MPNORM.VPOCHA(NLF,9) 124 : ENDIF 125 : C---------------------------------------- 126 : SEGINI CP, CV 127 : MLRECP = LRECP 128 : MLRECV = LRECV 129 : SEGACT MLRECP, MLRECV 130 : DO 10 I=1,(NSP-1) 131 : CP.GC(I)=MLRECP.PROG(I) 132 : CV.GC(I)=MLRECV.PROG(I) 133 : 10 CONTINUE 134 : CP.GC(NSP)=MLRECP.PROG(NSP) 135 : CV.GC(NSP)=MLRECV.PROG(NSP) 136 : C---------------------------- 137 : C Variables au centre 138 : C---------------------------- 139 : RC=MPRC.VPOCHA(NLC,1) 140 : PC=MPPC.VPOCHA(NLC,1) 141 : UXC=MPVC.VPOCHA(NLC,1) 142 : UYC=MPVC.VPOCHA(NLC,2) 143 : IF(IDIM.EQ.3)UZC=MPVC.VPOCHA(NLC,3) 144 : SEGINI YC 145 : SEGACT MPYN 146 : DO 100 I=1,(NSP-1) 147 : YC.YET(I)=MPYN.VPOCHA(NLC,I) 148 : 100 CONTINUE 149 : C---------------------------- 150 : C Variables à la face 151 : C---------------------------- 152 : RF=MPLIM.VPOCHA(NLCB,1) 153 : UXF=MPLIM.VPOCHA(NLCB,2) 154 : UYF=MPLIM.VPOCHA(NLCB,3) 155 : IF(IDIM.EQ.3)UZF=MPLIM.VPOCHA(NLCB,4) 156 : PF=MPLIM.VPOCHA(NLCB,IDIM+2) 157 : SEGINI YF 158 : DO 101 I=1,(NSP-1) 159 : YF.YET(I)=MPLIM.VPOCHA(NLCB,IDIM+2+I) 160 : 101 CONTINUE 161 : c------------------------------------------------------------- 162 : c Computing GAMMA at the cell-center 163 : c------------------------------------------------------------- 164 : top=0.0D0 165 : bot=0.0D0 166 : do 102 i=1,(nsp-1) 167 : top=top+yc.yet(i)*(cp.gc(i)-cp.gc(nsp)) 168 : bot=bot+yc.yet(i)*(cv.gc(i)-cv.gc(nsp)) 169 : 102 continue 170 : top=cp.gc(nsp)+top 171 : bot=cv.gc(nsp)+bot 172 : GAMC=top/bot 173 : c------------------------------------------------------------- 174 : c Computing GAMMA at the face-center 175 : c------------------------------------------------------------- 176 : top=0.0D0 177 : bot=0.0D0 178 : do 103 i=1,(nsp-1) 179 : top=top+yf.yet(i)*(cp.gc(i)-cp.gc(nsp)) 180 : bot=bot+yf.yet(i)*(cv.gc(i)-cv.gc(nsp)) 181 : 103 continue 182 : top=cp.gc(nsp)+top 183 : bot=cv.gc(nsp)+bot 184 : GAMF=top/bot 185 : C--------------------------------------- 186 : C******* On calcule UN, UT, UT2, ASON, S 187 : C--------------------------------------- 188 : UNC=(UXC*CNX)+(UYC*CNY)+(UZC*CNZ) 189 : UTC=(UXC*CTX)+(UYC*CTY)+(UZC*CTZ) 190 : UT2C=(UXC*CT2X)+(UYC*CT2Y)+(UZC*CT2Z) 191 : UNF=(UXF*CNX)+(UYF*CNY)+(UZF*CNZ) 192 : c UTF=(UXF*CTX)+(UYF*CTY)+(UZF*CTZ) 193 : c UT2F=(UXF*CT2X)+(UYF*CT2Y)+(UZF*CT2Z) 194 : C---------------------------------- 195 : ASONC=(GAMC*PC/RC)**0.5D0 196 : ASONF=(GAMF*PF/RF)**0.5D0 197 : C 198 : SC=PC/(RC**GAMC) 199 : c SF=PF/(RF**GAMF) 200 : C----------------------------------------------- 201 : C******* Densite, vitesse, pression sur le bord 202 : C----------------------------------------------- 203 : GAMM = 0.5D0*(GAMC+GAMF) 204 : G1=UNF-(2.0D0*ASONF)/(GAMF-1.0D0) 205 : G3=UNC+(2.0D0*ASONC)/(GAMC-1.0D0) 206 : UN=0.5D0*(G1+G3) 207 : ASON2=(0.5D0*(G3-G1)) 208 : ASON2=ASON2*(GAMM-1.0D0)/2.0D0 209 : ASON2=ASON2*ASON2 210 : S=SC 211 : UT=UTC 212 : UT2=UT2C 213 : RHO=ASON2/(GAMM*S) 214 : RHO=RHO**(1.0D0/(GAMC-1.0D0)) 215 : P=RHO*ASON2/GAMM 216 : UX=(UN*CNX)+(UT*CTX)+(UT2*CT2X) 217 : UY=(UN*CNY)+(UT*CTY)+(UT2*CT2Y) 218 : UZ=(UN*CNZ)+(UT*CTZ)+(UT2*CT2Z) 219 : C---------------------------------------- 220 : MPRLI.VPOCHA(NLCB,1)=RHO 221 : MPRLI.VPOCHA(NLCB,2)=UX 222 : MPRLI.VPOCHA(NLCB,3)=UY 223 : IF(IDIM.EQ.3) MPRLI.VPOCHA(NLCB,4)=UZ 224 : MPRLI.VPOCHA(NLCB,IDIM+2)=P 225 : do 104 i=1,(nsp-1) 226 : MPRLI.VPOCHA(NLCB,IDIM+2+I)=YC.YET(I) 227 : 104 continue 228 : C------------------------------------------------------- 229 : C******* Residuum (son SPG a le meme ordre que MELEFC) 230 : C------------------------------------------------------- 231 : MPRES.VPOCHA(IFAC,1)=-1*RHO*UN*SURF/VOLU 232 : MPRES.VPOCHA(IFAC,2)=-1*(RHO*UN*UX+(P*CNX))*SURF/VOLU 233 : MPRES.VPOCHA(IFAC,3)=-1*(RHO*UN*UY+(P*CNY))*SURF/VOLU 234 : IF(IDIM.EQ.3) 235 : & MPRES.VPOCHA(IFAC,4)=-1*(RHO*UN*UZ+(P*CNZ))*SURF/VOLU 236 : MPRES.VPOCHA(IFAC,IDIM+2)=-1*((UN*GAMM*P/(GAMM-1.0D0)) + 237 : & (0.5D0*RHO*UN*(UN*UN+UT*UT+UT2*UT2)))*SURF/VOLU 238 : do 105 i=1,(nsp-1) 239 : MPRES.VPOCHA(IFAC,IDIM+2+I)=-1.0D0*RHO*YC.YET(I)*UN*SURF/VOLU 240 : 105 continue 241 : 1 CONTINUE 242 : C 243 : SEGDES MELEFC 244 : C 245 : SEGSUP MLEMC 246 : SEGSUP MLEMCB 247 : SEGSUP MLEMF 248 : C 249 : SEGDES MPNORM 250 : SEGDES MPVOL 251 : SEGDES MPSURF 252 : SEGDES MPRC 253 : SEGDES MPPC 254 : SEGDES MPVC 255 : SEGDES MPYN 256 : SEGDES MPLIM 257 : SEGDES MPRES 258 : SEGDES MPRLI 259 : SEGDES MLRECP 260 : SEGDES MLRECV 261 : SEGDES YC 262 : SEGDES YF 263 : C 264 : 9999 CONTINUE 265 : RETURN 266 : END 267 : 268 : 269 : 270 : 271 : 272 : 273 : 274 : 275 :
© Cast3M 2003 - All rights reserved.
Disclaimer