1 : C CLI171 SOURCE CHAT 05/01/12 22:06:26 5004 2 : SUBROUTINE CLI171(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 : CLI171 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,USGM1 57 : & ,CT2X,CT2Y,CT2Z,UTF,UT2F 58 : & ,PC,PSRF,RHOUF,ECIN,P,RHO,UN,UT,UT2,UX,UY,UZ 59 : CHARACTER*(8) TYPE 60 : C 61 : C 62 : C**** KRIPAD pour la correspondance global/local 63 : C 63 : CALL KRIPAD(MELEMC,MLEMC) 64 : C SEGINI MLEMC 64 : CALL KRIPAD(MELECB,MLEMCB) 65 : C SEGINI MLEMCB 65 : CALL KRIPAD(MELEMF,MLEMF) 66 : C SEGINI MLEMF 67 : C 68 : C**** CHPOINTs de la table DOMAINE 69 : C 69 : CALL LICHT(INORM,MPNORM,TYPE,ICEL) 69 : CALL LICHT(ICHPVO,MPVOL,TYPE,ICEL) 69 : CALL LICHT(ICHPSU,MPSURF,TYPE,ICEL) 70 : C 71 : C**** LICHT active les MPOVALs en *MOD 72 : C 73 : C SEGACT MPNORM*MOD 74 : C SEGACT MPOVSU*MOD 75 : C SEGACT MPOVOL*MOD 76 : C 77 : C 78 : C**** CHPOINTs des variables 79 : C 79 : CALL LICHT(IROC,MPRC,TYPE,ICEL) 79 : CALL LICHT(IVITC,MPVC,TYPE,ICEL) 79 : CALL LICHT(IPC,MPPC,TYPE,ICEL) 79 : CALL LICHT(IGAMC,MPGAMC,TYPE,ICEL) 79 : CALL LICHT(ICHLIM,MPLIM,TYPE,ICEL) 79 : CALL LICHT(ICHRES,MPRES,TYPE,ICEL) 79 : CALL LICHT(ICHRLI,MPRLI,TYPE,ICEL) 80 : C 81 : C SEGACT *MOD 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 89 : C 90 : C**** Boucle sur le face pour le calcul des invariants de 91 : C Riemann et du flux 92 : C 93 : SEGACT MELEFC 94 : NFAC=MELEFC.NUM(/2) 95 : CNZ=0.0D0 96 : CTZ=0.0D0 97 : CT2X=0.0D0 98 : CT2Y=0.0D0 99 : CT2Z=0.0D0 100 : DO IFAC=1,NFAC,1 101 : NGF=MELEFC.NUM(1,IFAC) 102 : NGC=MELEFC.NUM(2,IFAC) 103 : NLF=MLEMF.LECT(NGF) 104 : NLC=MLEMC.LECT(NGC) 105 : NLCB=MLEMCB.LECT(NGF) 106 : VOLU=MPVOL.VPOCHA(NLC,1) 107 : SURF=MPSURF.VPOCHA(NLF,1) 108 : C In CASTEM les normales sont sortantes 109 : CNX=-1*MPNORM.VPOCHA(NLF,1) 110 : CNY=-1*MPNORM.VPOCHA(NLF,2) 111 : IF(IDIM.EQ.2)THEN 112 : CTX=-1.0D0*CNY 113 : CTY=CNX 114 : ELSE 115 : CNZ=-1*MPNORM.VPOCHA(NLF,3) 116 : CTX=-1*MPNORM.VPOCHA(NLF,4) 117 : CTY=-1*MPNORM.VPOCHA(NLF,5) 118 : CTZ=-1*MPNORM.VPOCHA(NLF,6) 119 : CT2X=-1*MPNORM.VPOCHA(NLF,7) 120 : CT2Y=-1*MPNORM.VPOCHA(NLF,8) 121 : CT2Z=-1*MPNORM.VPOCHA(NLF,9) 122 : ENDIF 123 : GAMC=MPGAMC.VPOCHA(NLC,1) 124 : GM1=GAMC-1.0D0 125 : USGM1=1.0D0/GM1 126 : C Variables au centre 127 : PC=MPPC.VPOCHA(NLC,1) 128 : C Variables à la face 129 : RHOUF=MPLIM.VPOCHA(NLCB,1) 130 : PSRF=MPLIM.VPOCHA(NLCB,2) 131 : UTF=0.0D0 132 : UT2F=0.0D0 133 : C 134 : C******* Variables à l'interface 135 : C 136 : P=PC 137 : RHO=P/PSRF 138 : UN=RHOUF/RHO 139 : UT=UTF 140 : UT2=UT2F 141 : C 142 : C******* On calcule U 143 : C 144 : UX=UN*CNX+UT*CTX+UT2*CT2X 145 : UY=UN*CNY+UT*CTY+UT2*CT2Y 146 : UZ=UN*CNZ+UT*CTZ+UT2*CT2Z 147 : C 148 : ECIN=0.5D0*((UX*UX)+(UY*UY)+(UZ*UZ)) 149 : C 150 : C******* Densite, vitesse, pression sur le bord 151 : C 152 : MPRLI.VPOCHA(NLCB,1)=RHO 153 : MPRLI.VPOCHA(NLCB,2)=UX 154 : MPRLI.VPOCHA(NLCB,3)=UY 155 : IF(IDIM.EQ.3) MPRLI.VPOCHA(NLCB,4)=UZ 156 : MPRLI.VPOCHA(NLCB,IDIM+2)=P 157 : C 158 : C 159 : C******* Residuum (son SPG a le meme ordre que MELEFC) 160 : C 161 : MPRES.VPOCHA(IFAC,1)=RHOUF*SURF/VOLU 162 : MPRES.VPOCHA(IFAC,2)=(RHOUF*UX+P*CNX)*SURF/VOLU 163 : MPRES.VPOCHA(IFAC,3)=(RHOUF*UY+P*CNY)*SURF/VOLU 164 : IF(IDIM.EQ.3)MPRES.VPOCHA(IFAC,4)=(RHOUF*UZ+P*CNZ)*SURF/VOLU 165 : MPRES.VPOCHA(IFAC,IDIM+2)=(RHOUF*((GAMC*USGM1*PSRF)+ECIN)) 166 : & *SURF/VOLU 167 : ENDDO 168 : C 169 : SEGDES MELEFC 170 : C 171 : SEGSUP MLEMC 172 : SEGSUP MLEMCB 173 : SEGSUP MLEMF 174 : C 175 : SEGDES MPNORM 176 : SEGDES MPVOL 177 : SEGDES MPSURF 178 : SEGDES MPRC 179 : SEGDES MPPC 180 : SEGDES MPVC 181 : SEGDES MPGAMC 182 : SEGDES MPLIM 183 : SEGDES MPRES 184 : SEGDES MPRLI 185 : C 186 : 9999 CONTINUE 187 : RETURN 188 : END 189 : 190 : 191 : 192 : 193 : 194 : 195 : 196 :
© Cast3M 2003 - All rights reserved.
Disclaimer