1 : C CLI271 SOURCE CHAT 05/01/12 22:07:35 5004 2 : SUBROUTINE CLI271(NSP,MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO, 3 : & ICHPSU,LRECP,LRECV,IROC,IVITC,IPC,ICHLIM,ICHRES,ICHRLI) 4 : C************************************************************************ 5 : C 6 : C PROJET : CASTEM 2000 7 : C 8 : C NOM : CLI271 9 : C 10 : C DESCRIPTION : Subroutine appellée par CLIM22 11 : C OPTION: 'INJE' 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 : & ,IGAMC,ICHLIM,ICHRES,ICHRLI,ICEL,NFAC,IFAC 56 : & ,NGF,NGC,NLF,NLC,NLCB,LRECP,LRECV,NSP,I 57 : REAL*8 VOLU,SURF,GAMF,CNX,CNY,CNZ,CTX,CTY,CTZ,GM1,USGM1 58 : & ,CT2X,CT2Y,CT2Z,UTF,UT2F,TOP,BOT 59 : & ,PC,PSRF,RHOUF,ECIN,P,RHO,UN,UT,UT2,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 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(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 : CNZ=0.0D0 94 : CTZ=0.0D0 95 : CT2X=0.0D0 96 : CT2Y=0.0D0 97 : CT2Z=0.0D0 98 : DO IFAC=1,NFAC,1 99 : NGF=MELEFC.NUM(1,IFAC) 100 : NGC=MELEFC.NUM(2,IFAC) 101 : NLF=MLEMF.LECT(NGF) 102 : NLC=MLEMC.LECT(NGC) 103 : NLCB=MLEMCB.LECT(NGF) 104 : VOLU=MPVOL.VPOCHA(NLC,1) 105 : SURF=MPSURF.VPOCHA(NLF,1) 106 : C In CASTEM les normales sont sortantes 107 : CNX=-1*MPNORM.VPOCHA(NLF,1) 108 : CNY=-1*MPNORM.VPOCHA(NLF,2) 109 : IF(IDIM.EQ.2)THEN 110 : CTX=-1.0D0*CNY 111 : CTY=CNX 112 : ELSE 113 : CNZ=-1*MPNORM.VPOCHA(NLF,3) 114 : CTX=-1*MPNORM.VPOCHA(NLF,4) 115 : CTY=-1*MPNORM.VPOCHA(NLF,5) 116 : CTZ=-1*MPNORM.VPOCHA(NLF,6) 117 : CT2X=-1*MPNORM.VPOCHA(NLF,7) 118 : CT2Y=-1*MPNORM.VPOCHA(NLF,8) 119 : CT2Z=-1*MPNORM.VPOCHA(NLF,9) 120 : ENDIF 121 : C-------------------------------------------- 122 : SEGINI CP, CV 123 : MLRECP = LRECP 124 : MLRECV = LRECV 125 : SEGACT MLRECP, MLRECV 126 : DO 10 I=1,(NSP-1) 127 : CP.GC(I)=MLRECP.PROG(I) 128 : CV.GC(I)=MLRECV.PROG(I) 129 : 10 CONTINUE 130 : CP.GC(NSP)=MLRECP.PROG(NSP) 131 : CV.GC(NSP)=MLRECV.PROG(NSP) 132 : C---------------------------------------- 133 : C Variables au centre 134 : C---------------------------------------- 135 : PC=MPPC.VPOCHA(NLC,1) 136 : C---------------------------------------- 137 : C Variables à la face 138 : C---------------------------------------- 139 : RHOUF=MPLIM.VPOCHA(NLCB,1) 140 : PSRF=MPLIM.VPOCHA(NLCB,2) 141 : UTF=0.0D0 142 : UT2F=0.0D0 143 : C---------------------------------------- 144 : C******* Variables à l'interface 145 : C---------------------------------------- 146 : P=PC 147 : RHO=P/PSRF 148 : UN=RHOUF/RHO 149 : UT=UTF 150 : UT2=UT2F 151 : SEGINI YF 152 : DO 101 I=1,(NSP-1) 153 : YF.YET(I)=MPLIM.VPOCHA(NLCB,2+I) 154 : 101 CONTINUE 155 : c------------------------------------------------------------- 156 : c Computing GAMMA at the face-center 157 : c------------------------------------------------------------- 158 : top=0.0D0 159 : bot=0.0D0 160 : do 103 i=1,(nsp-1) 161 : top=top+yf.yet(i)*(cp.gc(i)-cp.gc(nsp)) 162 : bot=bot+yf.yet(i)*(cv.gc(i)-cv.gc(nsp)) 163 : 103 continue 164 : top=cp.gc(nsp)+top 165 : bot=cv.gc(nsp)+bot 166 : GAMF=top/bot 167 : C----------------------------------------- 168 : C******* On calcule U 169 : C----------------------------------------- 170 : UX=UN*CNX+UT*CTX+UT2*CT2X 171 : UY=UN*CNY+UT*CTY+UT2*CT2Y 172 : UZ=UN*CNZ+UT*CTZ+UT2*CT2Z 173 : C--------------------------------------------- 174 : ECIN=0.5D0*((UX*UX)+(UY*UY)+(UZ*UZ)) 175 : C------------------------------------------------ 176 : C******* Densite, vitesse, pression sur le bord 177 : C------------------------------------------------ 178 : MPRLI.VPOCHA(NLCB,1)=RHO 179 : MPRLI.VPOCHA(NLCB,2)=UX 180 : MPRLI.VPOCHA(NLCB,3)=UY 181 : IF(IDIM.EQ.3) MPRLI.VPOCHA(NLCB,4)=UZ 182 : MPRLI.VPOCHA(NLCB,IDIM+2)=P 183 : do 104 i=1,(nsp-1) 184 : MPRLI.VPOCHA(NLCB,IDIM+2+I)=YF.YET(I) 185 : 104 continue 186 : C-------------------------------------------------------- 187 : C******* Residuum (son SPG a le meme ordre que MELEFC) 188 : C-------------------------------------------------------- 189 : USGM1 = 1.0D0/(GAMF-1.0D0) 190 : MPRES.VPOCHA(IFAC,1)=RHOUF*SURF/VOLU 191 : MPRES.VPOCHA(IFAC,2)=(RHOUF*UX+P*CNX)*SURF/VOLU 192 : MPRES.VPOCHA(IFAC,3)=(RHOUF*UY+P*CNY)*SURF/VOLU 193 : IF(IDIM.EQ.3)MPRES.VPOCHA(IFAC,4)=(RHOUF*UZ+P*CNZ)*SURF/VOLU 194 : MPRES.VPOCHA(IFAC,IDIM+2)=(RHOUF*((GAMF*USGM1*PSRF)+ECIN)) 195 : & *SURF/VOLU 196 : do 105 i=1,(nsp-1) 197 : MPRES.VPOCHA(IFAC,IDIM+2+I)=RHOUF*YF.YET(I)*SURF/VOLU 198 : 105 continue 199 : ENDDO 200 : C 201 : SEGDES MELEFC 202 : C 203 : SEGSUP MLEMC 204 : SEGSUP MLEMCB 205 : SEGSUP MLEMF 206 : C 207 : SEGDES MPNORM 208 : SEGDES MPVOL 209 : SEGDES MPSURF 210 : SEGDES MPRC 211 : SEGDES MPPC 212 : SEGDES MPVC 213 : SEGDES MPLIM 214 : SEGDES MPRES 215 : SEGDES MPRLI 216 : SEGDES MLRECP 217 : SEGDES MLRECV 218 : SEGDES YF 219 : C 220 : 9999 CONTINUE 221 : RETURN 222 : END 223 : 224 : 225 : 226 : 227 : 228 : 229 : 230 : 231 :
© Cast3M 2003 - All rights reserved.
Disclaimer