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