1 : C CLI191 SOURCE PV 11/03/07 21:15:31 6885 2 : SUBROUTINE CLI191(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 : CLI191 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 : 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 : IMPLICIT REAL*8(A-H,O-Z) 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, MPGAMC.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 57 : REAL*8 VOLU,SURF,GAMC,CNX,CNY,CNZ,CTX,CTY,CTZ,GM1,USGM1 58 : & ,CT2X,CT2Y,CT2Z,UTF,UT2F 59 : & ,PC,PF,TF,ECIN,P,RHO,UN,UT,UT2,UX,UY,UZ 60 : & ,RHOC,UXC,UYC,UZC,UNC,RAIR,SF 61 : 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 : CNZ=0.0D0 99 : CTZ=0.0D0 100 : CT2X=0.0D0 101 : CT2Y=0.0D0 102 : CT2Z=0.0D0 103 : UZC=0.0D0 104 : DO IFAC=1,NFAC,1 105 : NGF=MELEFC.NUM(1,IFAC) 106 : NGC=MELEFC.NUM(2,IFAC) 107 : NLF=MLEMF.LECT(NGF) 108 : NLC=MLEMC.LECT(NGC) 109 : NLCB=MLEMCB.LECT(NGF) 110 : VOLU=MPVOL.VPOCHA(NLC,1) 111 : SURF=MPSURF.VPOCHA(NLF,1) 112 : C In CASTEM les normales sont sortantes 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 : GAMC=MPGAMC.VPOCHA(NLC,1) 128 : GM1=GAMC-1.0D0 129 : USGM1=1.0D0/GM1 130 : C Variables au centre 131 : PC=MPPC.VPOCHA(NLC,1) 132 : RHOC=MPRC.VPOCHA(NLC,1) 133 : UXC=MPVC.VPOCHA(NLC,1) 134 : UYC=MPVC.VPOCHA(NLC,2) 135 : IF(IDIM.EQ.3) UZC=MPVC.VPOCHA(NLC,3) 136 : UNC=(UXC*CNX)+(UYC*CNY)+(UZC*CNZ) 137 : C Variables in the tank (stagnation values) 138 : PF=MPLIM.VPOCHA(NLCB,1) 139 : RF=MPLIM.VPOCHA(NLCB,2) 140 : UTF=0.0D0 141 : UT2F=0.0D0 142 : C 143 : C******* Variables à l'interface 144 : C 145 : c!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 146 : C******* entropy in the tank 147 : SF = PF/(RF**GAMC) 148 : c!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 149 : RHO=((2.0/(GAMC + 1.0))**USGM1)*RF 150 : P = SF * (RHO**GAMC) 151 : UN=(GAMC*P/RHO)**0.5 152 : UT=UTF 153 : UT2=UT2F 154 : C 155 : C******* On calcule U 156 : C 157 : UX=UN*CNX+UT*CTX+UT2*CT2X 158 : UY=UN*CNY+UT*CTY+UT2*CT2Y 159 : UZ=UN*CNZ+UT*CTZ+UT2*CT2Z 160 : C 161 : ECIN=0.5D0*((UX*UX)+(UY*UY)+(UZ*UZ)) 162 : C 163 : C******* Densite, vitesse, pression sur le bord 164 : C 165 : MPRLI.VPOCHA(NLCB,1)=RHO 166 : MPRLI.VPOCHA(NLCB,2)=UX 167 : MPRLI.VPOCHA(NLCB,3)=UY 168 : IF(IDIM.EQ.3) MPRLI.VPOCHA(NLCB,4)=UZ 169 : MPRLI.VPOCHA(NLCB,IDIM+2)=P 170 : C 171 : C 172 : C******* Residuum (son SPG a le meme ordre que MELEFC) 173 : C 174 : MPRES.VPOCHA(IFAC,1)=RHO*UN*SURF/VOLU 175 : MPRES.VPOCHA(IFAC,2)=((RHO*UN*UX)+(P*CNX))*SURF/VOLU 176 : MPRES.VPOCHA(IFAC,3)=((RHO*UN*UY)+(P*CNY))*SURF/VOLU 177 : IF(IDIM.EQ.3)MPRES.VPOCHA(IFAC,4)=((RHO*UN*UZ)+ 178 : & (P*CNZ))*SURF/VOLU 179 : MPRES.VPOCHA(IFAC,IDIM+2)=(RHO*UN*((GAMC*USGM1*P/RHO)+ECIN)) 180 : & *SURF/VOLU 181 : ENDDO 182 : C 183 : SEGDES MELEFC 184 : C 185 : SEGSUP MLEMC 186 : SEGSUP MLEMCB 187 : SEGSUP MLEMF 188 : C 189 : SEGDES MPNORM 190 : SEGDES MPVOL 191 : SEGDES MPSURF 192 : SEGDES MPRC 193 : SEGDES MPPC 194 : SEGDES MPVC 195 : SEGDES MPGAMC 196 : SEGDES MPLIM 197 : SEGDES MPRES 198 : SEGDES MPRLI 199 : C 200 : 9999 CONTINUE 201 : RETURN 202 : END 203 : 204 : 205 : 206 : 207 : 208 : 209 : 210 : 211 : 212 : 213 :
© Cast3M 2003 - All rights reserved.
Disclaimer