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