1 : C CLI161 SOURCE CHAT 05/01/12 22:06:08 5004 2 : SUBROUTINE CLI161(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 : CLI161 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,GAMC,CNX,CNY,CNZ,CTX,CTY,CTZ,GM1 57 : & ,CT2X,CT2Y,CT2Z,RF,PF,UXF,UYF,UZF,UNF,UTF,UT2F 58 : & ,UXC,UYC,UZC,RC,PC,UNC,UTC,UT2C 59 : & ,HTF,SF,ECIN,PSRF,CELL(1),CELLT,FLUX2D(4),FLUX3D(5) 60 : CHARACTER*(8) TYPE 61 : C 62 : C 63 : C**** KRIPAD pour la correspondance global/local 64 : C 64 : CALL KRIPAD(MELEMC,MLEMC) 65 : C SEGINI MLEMC 65 : CALL KRIPAD(MELECB,MLEMCB) 66 : C SEGINI MLEMCB 66 : CALL KRIPAD(MELEMF,MLEMF) 67 : C SEGINI MLEMF 68 : C 69 : C**** CHPOINTs de la table DOMAINE 70 : C 70 : CALL LICHT(INORM,MPNORM,TYPE,ICEL) 70 : CALL LICHT(ICHPVO,MPVOL,TYPE,ICEL) 70 : CALL LICHT(ICHPSU,MPSURF,TYPE,ICEL) 71 : C 72 : C**** LICHT active les MPOVALs en *MOD 73 : C 74 : C SEGACT MPNORM*MOD 75 : C SEGACT MPOVSU*MOD 76 : C SEGACT MPOVOL*MOD 77 : C 78 : C 79 : C**** CHPOINTs des variables 80 : C 80 : CALL LICHT(IROC,MPRC,TYPE,ICEL) 80 : CALL LICHT(IVITC,MPVC,TYPE,ICEL) 80 : CALL LICHT(IPC,MPPC,TYPE,ICEL) 80 : CALL LICHT(IGAMC,MPGAMC,TYPE,ICEL) 80 : CALL LICHT(ICHLIM,MPLIM,TYPE,ICEL) 80 : CALL LICHT(ICHRES,MPRES,TYPE,ICEL) 80 : CALL LICHT(ICHRLI,MPRLI,TYPE,ICEL) 81 : C 82 : C SEGACT *MOD 83 : C SEGACT *MOD 84 : C SEGACT *MOD 85 : C SEGACT *MOD 86 : C SEGACT *MOD 87 : C SEGACT *MOD 88 : C SEGACT *MOD 89 : C 90 : C 91 : C**** Boucle sur le face pour le calcul des invariants de 92 : C Riemann et du flux 93 : C 94 : SEGACT MELEFC 95 : NFAC=MELEFC.NUM(/2) 96 : UZC=0.0D0 97 : UZF=0.0D0 98 : UT2F=0.0D0 99 : CNZ=0.0D0 100 : CTZ=0.0D0 101 : CT2X=0.0D0 102 : CT2Y=0.0D0 103 : CT2Z=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 : C Variables au centre 130 : RC=MPRC.VPOCHA(NLC,1) 131 : UXC=MPVC.VPOCHA(NLC,1) 132 : UYC=MPVC.VPOCHA(NLC,2) 133 : IF(IDIM.EQ.3) UZC=MPVC.VPOCHA(NLC,3) 134 : PC=MPPC.VPOCHA(NLC,1) 135 : C Variables à la face 136 : HTF=MPLIM.VPOCHA(NLCB,1) 137 : SF=MPLIM.VPOCHA(NLCB,2) 138 : UTF=0.0D0 139 : C 140 : C******* On calcule UNC 141 : C 142 : UNC=(UXC*CNX)+(UYC*CNY)+(UZC*CNZ) 143 : UTC=(UXC*CTX)+(UYC*CTY)+(UZC*CTZ) 144 : UT2C=(UXC*CT2X)+(UYC*CT2Y)+(UZC*CT2Z) 145 : UNF=UNC 146 : C 147 : C******* On calcule UN, UT, UT2 148 : C 149 : UXF=UNF*CNX+UTF*CTX+UT2F*CT2X 150 : UYF=UNF*CNY+UTF*CTY+UT2F*CT2Y 151 : UZF=UNF*CNZ+UTF*CTZ+UT2F*CT2Z 152 : C 153 : ECIN=0.5D0*((UXF*UXF)+(UYF*UYF)+(UZF*UZF)) 154 : PSRF=(GM1/GAMC)*(HTF-ECIN) 155 : RF=PSRF/SF 156 : RF=RF**(1.0D0/GM1) 157 : PF=SF*(RF**GAMC) 158 : C 159 : C******* Densite, vitesse, pression sur le bord 160 : C 161 : MPRLI.VPOCHA(NLCB,1)=RF 162 : MPRLI.VPOCHA(NLCB,2)=UXF 163 : MPRLI.VPOCHA(NLCB,3)=UYF 164 : IF(IDIM.EQ.3) MPRLI.VPOCHA(NLCB,4)=UZF 165 : MPRLI.VPOCHA(NLCB,IDIM+2)=PF 166 : C 167 : IF(IDIM.EQ.2)THEN 167 : CALL FAUSMP(0, 168 : & GAMC,RF,PF,UNC,UTF, 169 : & GAMC,RC,PC,UNC,UTC, 170 : & CELL,CELL, 171 : & FLUX2D, 172 : & CELLT) 173 : C 174 : C******* Residuum (son SPG a le meme ordre que MELEFC) 175 : C 176 : MPRES.VPOCHA(IFAC,1)=FLUX2D(1)*SURF/VOLU 177 : MPRES.VPOCHA(IFAC,2)=((FLUX2D(2)*CNX)+(FLUX2D(3)*CTX)) 178 : & *SURF/VOLU 179 : MPRES.VPOCHA(IFAC,3)=((FLUX2D(2)*CNY)+(FLUX2D(3)*CTY)) 180 : & *SURF/VOLU 181 : MPRES.VPOCHA(IFAC,4)=FLUX2D(4)*SURF/VOLU 182 : ELSE 182 : CALL FAUSM3(0, 183 : & GAMC,RF,PF,UNC,UTF,UT2F, 184 : & GAMC,RC,PC,UNC,UTC,UT2C, 185 : & CELL,CELL, 186 : & FLUX3D, 187 : & CELLT) 188 : C 189 : C******* Residuum (son SPG a le meme ordre que MELEFC) 190 : C 191 : MPRES.VPOCHA(IFAC,1)=FLUX3D(1)*SURF/VOLU 192 : MPRES.VPOCHA(IFAC,2)=((FLUX3D(2)*CNX)+(FLUX3D(3)*CTX)+ 193 : & (FLUX3D(4)*CT2X))*SURF/VOLU 194 : MPRES.VPOCHA(IFAC,3)=((FLUX3D(2)*CNY)+(FLUX3D(3)*CTY)+ 195 : & (FLUX3D(4)*CT2Y))*SURF/VOLU 196 : MPRES.VPOCHA(IFAC,4)=((FLUX3D(2)*CNZ)+(FLUX3D(3)*CTZ)+ 197 : & (FLUX3D(4)*CT2Z))*SURF/VOLU 198 : MPRES.VPOCHA(IFAC,5)=FLUX3D(5)*SURF/VOLU 199 : ENDIF 200 : 201 : ENDDO 202 : C 203 : SEGDES MELEFC 204 : C 205 : SEGSUP MLEMC 206 : SEGSUP MLEMCB 207 : SEGSUP MLEMF 208 : C 209 : SEGDES MPNORM 210 : SEGDES MPVOL 211 : SEGDES MPSURF 212 : SEGDES MPRC 213 : SEGDES MPPC 214 : SEGDES MPVC 215 : SEGDES MPGAMC 216 : SEGDES MPLIM 217 : SEGDES MPRES 218 : SEGDES MPRLI 219 : C 220 : 9999 CONTINUE 221 : RETURN 222 : END 223 : 224 : 225 : 226 : 227 : 228 : 229 : 230 :
© Cast3M 2003 - All rights reserved.
Disclaimer