1 : C CLI121 SOURCE CHAT 05/01/12 22:05:13 5004 2 : SUBROUTINE CLI121(MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO,ICHPSU, 3 : & IROC,IVITC,IPC,IGAMC,ICHLIM,ICHRES,ICHRLI) 4 : C************************************************************************ 5 : C 6 : C PROJET : CASTEM 2000 7 : C 8 : C NOM : CLI121 9 : C 10 : C DESCRIPTION : Subroutine appellée par CLIM11 11 : C 12 : C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI) 13 : C 14 : C AUTEUR : A. BECCANTINI, 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, MPGAMC.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 : & ,IGAMC,ICHLIM,ICHRES,ICHRLI,ICEL,NFAC,IFAC 55 : & ,NGF,NGC,NLF,NLC,NLCB 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 58 : & ,UNC,UNF,ASONC,ASONF 59 : * & ,UTF,UT2F,SF 60 : & ,UTC,UT2C,SC 61 : & ,USGM1,DSGM1,G1,G3,ASON2,S,UT,UT2,UN,RHO,P,UX,UY,UZ 62 : * & ,CACCA,EPS 63 : CHARACTER*(8) TYPE 64 : C 65 : C 66 : C**** KRIPAD pour la correspondance global/local 67 : C 67 : CALL KRIPAD(MELEMC,MLEMC) 68 : C SEGINI MLEMC 68 : CALL KRIPAD(MELECB,MLEMCB) 69 : C SEGINI MLEMCB 69 : CALL KRIPAD(MELEMF,MLEMF) 70 : C SEGINI MLEMF 71 : C 72 : C**** CHPOINTs de la table DOMAINE 73 : C 73 : CALL LICHT(INORM,MPNORM,TYPE,ICEL) 73 : CALL LICHT(ICHPVO,MPVOL,TYPE,ICEL) 73 : CALL LICHT(ICHPSU,MPSURF,TYPE,ICEL) 74 : C 75 : C**** LICHT active les MPOVALs en *MOD 76 : C 77 : C SEGACT MPNORM*MOD 78 : C SEGACT MPOVSU*MOD 79 : C SEGACT MPOVOL*MOD 80 : C 81 : C 82 : C**** CHPOINTs des variables 83 : C 83 : CALL LICHT(IROC,MPRC,TYPE,ICEL) 83 : CALL LICHT(IVITC,MPVC,TYPE,ICEL) 83 : CALL LICHT(IPC,MPPC,TYPE,ICEL) 83 : CALL LICHT(IGAMC,MPGAMC,TYPE,ICEL) 83 : CALL LICHT(ICHLIM,MPLIM,TYPE,ICEL) 83 : CALL LICHT(ICHRES,MPRES,TYPE,ICEL) 83 : CALL LICHT(ICHRLI,MPRLI,TYPE,ICEL) 84 : C 85 : C SEGACT *MOD 86 : C SEGACT *MOD 87 : C SEGACT *MOD 88 : C SEGACT *MOD 89 : C SEGACT *MOD 90 : C SEGACT *MOD 91 : C SEGACT *MOD 92 : C 93 : C 94 : C**** Boucle sur le face pour le calcul des invariants de 95 : C Riemann et du flux 96 : C 97 : SEGACT MELEFC 98 : NFAC=MELEFC.NUM(/2) 99 : UZC=0.0D0 100 : UZF=0.0D0 101 : CNZ=0.0D0 102 : CTZ=0.0D0 103 : CT2X=0.0D0 104 : CT2Y=0.0D0 105 : CT2Z=0.0D0 106 : DO IFAC=1,NFAC,1 107 : NGF=MELEFC.NUM(1,IFAC) 108 : NGC=MELEFC.NUM(2,IFAC) 109 : NLF=MLEMF.LECT(NGF) 110 : NLC=MLEMC.LECT(NGC) 111 : NLCB=MLEMCB.LECT(NGF) 112 : VOLU=MPVOL.VPOCHA(NLC,1) 113 : SURF=MPSURF.VPOCHA(NLF,1) 114 : C In CASTEM les normales sont sortantes 115 : CNX=MPNORM.VPOCHA(NLF,1) 116 : CNY=MPNORM.VPOCHA(NLF,2) 117 : IF(IDIM.EQ.2)THEN 118 : CTX=-1.0D0*CNY 119 : CTY=CNX 120 : ELSE 121 : CNZ=MPNORM.VPOCHA(NLF,3) 122 : CTX=MPNORM.VPOCHA(NLF,4) 123 : CTY=MPNORM.VPOCHA(NLF,5) 124 : CTZ=MPNORM.VPOCHA(NLF,6) 125 : CT2X=MPNORM.VPOCHA(NLF,7) 126 : CT2Y=MPNORM.VPOCHA(NLF,8) 127 : CT2Z=MPNORM.VPOCHA(NLF,9) 128 : ENDIF 129 : C Variables au centre 130 : RC=MPRC.VPOCHA(NLC,1) 131 : PC=MPPC.VPOCHA(NLC,1) 132 : UXC=MPVC.VPOCHA(NLC,1) 133 : UYC=MPVC.VPOCHA(NLC,2) 134 : GAMC=MPGAMC.VPOCHA(NLC,1) 135 : IF(IDIM.EQ.3)UZC=MPVC.VPOCHA(NLC,3) 136 : C Variables à la face 137 : RF=MPLIM.VPOCHA(NLCB,1) 138 : UXF=MPLIM.VPOCHA(NLCB,2) 139 : UYF=MPLIM.VPOCHA(NLCB,3) 140 : IF(IDIM.EQ.3)UZF=MPLIM.VPOCHA(NLCB,4) 141 : PF=MPLIM.VPOCHA(NLCB,IDIM+2) 142 : C 143 : C******* On calcule UN, UT, UT2, ASON, S 144 : C 145 : UNC=(UXC*CNX)+(UYC*CNY)+(UZC*CNZ) 146 : UTC=(UXC*CTX)+(UYC*CTY)+(UZC*CTZ) 147 : UT2C=(UXC*CT2X)+(UYC*CT2Y)+(UZC*CT2Z) 148 : UNF=(UXF*CNX)+(UYF*CNY)+(UZF*CNZ) 149 : * UTF=(UXF*CTX)+(UYF*CTY)+(UZF*CTZ) 150 : * UT2F=(UXF*CT2X)+(UYF*CT2Y)+(UZF*CT2Z) 151 : C 152 : ASONC=(GAMC*PC/RC)**0.5D0 153 : ASONF=(GAMC*PF/RF)**0.5D0 154 : C 155 : SC=PC/(RC**GAMC) 156 : * SF=PF/(RF**GAMC) 157 : C 158 : C******* Densite, vitesse, pression sur le bord 159 : C 160 : USGM1=1.0D0/(GAMC-1.0D0) 161 : DSGM1=2.0D0*USGM1 162 : G1=UNF-(DSGM1*ASONF) 163 : G3=UNC+(DSGM1*ASONC) 164 : UN=0.5D0*(G1+G3) 165 : ASON2=(0.5D0*(G3-G1)) 166 : ASON2=ASON2/DSGM1 167 : ASON2=ASON2*ASON2 168 : S=SC 169 : UT=UTC 170 : UT2=UT2C 171 : RHO=ASON2/(GAMC*S) 172 : RHO=RHO**USGM1 173 : P=RHO*ASON2/GAMC 174 : UX=(UN*CNX)+(UT*CTX)+(UT2*CT2X) 175 : UY=(UN*CNY)+(UT*CTY)+(UT2*CT2Y) 176 : UZ=(UN*CNZ)+(UT*CTZ)+(UT2*CT2Z) 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 : C 184 : C******************************************************* 185 : C******* Test : we compute RHO*UN*SURF/VOLU 186 : C and its derivative with respect to RHO 187 : CC******************************************************* 188 : CC 189 : C CACCA=RHO*UN*SURF/VOLU 190 : C EPS=1.0D-6 191 : C RC=RC*(1+EPS) 192 : CC 193 : CC******* On calcule UN, UT, UT2, ASON, S 194 : CC 195 : C UNC=(UXC*CNX)+(UYC*CNY)+(UZC*CNZ) 196 : C* UTC=(UXC*CTX)+(UYC*CTY)+(UZC*CTZ) 197 : C* UT2C=(UXC*CT2X)+(UYC*CT2Y)+(UZC*CT2Z) 198 : C UNF=(UXF*CNX)+(UYF*CNY)+(UZF*CNZ) 199 : C UTF=(UXF*CTX)+(UYF*CTY)+(UZF*CTZ) 200 : C UT2F=(UXF*CT2X)+(UYF*CT2Y)+(UZF*CT2Z) 201 : CC 202 : C ASONC=(GAMC*PC/RC)**0.5D0 203 : C ASONF=(GAMC*PF/RF)**0.5D0 204 : CC 205 : C* SC=PC/(RC**GAMC) 206 : C SF=PF/(RF**GAMC) 207 : CC 208 : CC******* Densite, vitesse, pression sur le bord 209 : CC 210 : C USGM1=1.0D0/(GAMC-1.0D0) 211 : C DSGM1=2.0D0*USGM1 212 : C G1=UNC-(DSGM1*ASONC) 213 : C G3=UNF+(DSGM1*ASONF) 214 : C UN=0.5D0*(G1+G3) 215 : C ASON2=(0.5D0*(G3-G1)) 216 : C ASON2=ASON2/DSGM1 217 : C ASON2=ASON2*ASON2 218 : C S=SF 219 : C UT=UTF 220 : C UT2=UT2F 221 : C RHO=ASON2/(GAMC*S) 222 : C RHO=RHO**USGM1 223 : C write(*,*) (((RHO*UN*SURF/VOLU) - CACCA)/(RC*EPS)) 224 : CC******************************************************* 225 : C*************** FIN TEST ****************************** 226 : C******************************************************* 227 : C 228 : C******* Residuum (son SPG a le meme ordre que MELEFC) 229 : C 230 : MPRES.VPOCHA(IFAC,1)=-1*RHO*UN*SURF/VOLU 231 : MPRES.VPOCHA(IFAC,2)=-1*(RHO*UN*UX+(P*CNX))*SURF/VOLU 232 : MPRES.VPOCHA(IFAC,3)=-1*(RHO*UN*UY+(P*CNY))*SURF/VOLU 233 : IF(IDIM.EQ.3) 234 : & MPRES.VPOCHA(IFAC,4)=-1*(RHO*UN*UZ+(P*CNZ))*SURF/VOLU 235 : MPRES.VPOCHA(IFAC,IDIM+2)=-1*((UN*GAMC*USGM1*P) + 236 : & (0.5D0*RHO*UN*(UN*UN+UT*UT+UT2*UT2)))*SURF/VOLU 237 : ENDDO 238 : C 239 : SEGDES MELEFC 240 : C 241 : SEGSUP MLEMC 242 : SEGSUP MLEMCB 243 : SEGSUP MLEMF 244 : C 245 : SEGDES MPNORM 246 : SEGDES MPVOL 247 : SEGDES MPSURF 248 : SEGDES MPRC 249 : SEGDES MPPC 250 : SEGDES MPVC 251 : SEGDES MPGAMC 252 : SEGDES MPLIM 253 : SEGDES MPRES 254 : SEGDES MPRLI 255 : C 256 : 9999 CONTINUE 257 : RETURN 258 : END 259 : 260 : 261 : 262 : 263 : 264 : 265 : 266 :
© Cast3M 2003 - All rights reserved.
Disclaimer