1 : C KON181 SOURCE MAGN 09/07/30 21:17:40 6458 2 : SUBROUTINE KON181(MELEMC,IDIAM,MLMCON,MLMPRI,IRN,IVN,IPN,IGAMN, 3 : & IUPRI,IUPRI2,IJACO) 4 : C 5 : C************************************************************************ 6 : C 7 : C PROJET : CASTEM 2000 8 : C 9 : C NOM : KON181 10 : C 11 : C DESCRIPTION : Voir KON18 11 : C Cas deux dimensions, gaz "calorically perfect" 12 : C 13 : C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI) 14 : C 15 : C AUTEUR : Chezarovich , DM2S/SFME/LTMF 16 : C S. Kudriakov, DM2S/SFME/LTMF 17 : C************************************************************************ 18 : C 19 : C ENTREES 20 : C 21 : C MELEMC : SPG des CHPOINTs 22 : C 23 : C IDIAM : diametre de l'elt 24 : C 25 : C MLMPRI : liste des inconnues primitives (P,v,T) 26 : C 27 : C MLMCON : liste des inconnues conservatives (rho, rhov, rhoet) 28 : C 29 : C IRN : CHPOINT CENTRE contenant la densité 30 : C 31 : C IVN : CHPOINT CENTRE contenant la vitesse 32 : C 33 : C IVN : CHPOINT CENTRE contenant la pression 34 : C 35 : C IGAM : CHPOINT CENTRE contenant le gamma 36 : C 37 : C IUPRI : CHPOINT CENTRE contenant la vitesse "cut-off" 38 : C 39 : C IUPRI2 : CHPOINT CENTRE contenant la vitesse "cut-off" 40 : C 41 : C SORTIES 42 : C 43 : C IJACO : pointeur de la MATRIK jacobienne 44 : C 45 : C************************************************************************ 46 : C 47 : C HISTORIQUE (Anomalies et modifications éventuelles) 48 : C 49 : C HISTORIQUE : crée le 29.05.02 50 : C 51 : C************************************************************************ 52 : C 53 : C 54 : C N.B.: On suppose qu'on a déjà controllé RO, P > 0 55 : C GAMMA \in (1,3) 56 : C Si non il faut le faire!!! 57 : C 58 : C************************************************************************ 59 : C 60 : C 61 : C**** Variables de COOPTIO 62 : C 63 : C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR 64 : C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ 65 : C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES 66 : C & ,IECHO, IIMPI, IOSPI 67 : C & ,IDIM 68 : C & ,MCOORD 69 : C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE 70 : C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU 71 : C & ,NORINC,NORVAL,NORIND,NORVAD 72 : C & ,NUCROU, IPSAUV, IFICLE, IPREFI 73 : C 74 : IMPLICIT INTEGER(I-N) 75 : INTEGER IRN, IVN, IPN, IGAMN, IJACO, IGEOM, ICEN 76 : & , MP, NP, NBEL, NBME, NBSOUS, IUPRI, IUPRI2 77 : & , NRIGE, NMATRI, NKID, NKMT, IDIAM 78 : C 79 : REAL*8 RHO,UX, UY, GAMMA, PN, ARS, UR, THETA, H, MM, EPSIL, QQ 80 : & ,AR, UPRI, UPRI2, DIAM, LAMBDA, MREF, MREF2, MACH, MACH2 81 : & ,DTAUM1 82 : PARAMETER(EPSIL=1.0D0) 83 : CHARACTER*8 TYPE 84 : C 85 : C**** LES INCLUDES 86 : C 87 : -INC CCOPTIO 88 : -INC SMCHPOI 89 : -INC SMMATRIK 90 : -INC SMELEME 91 : -INC SMLMOTS 92 : -INC SMLENTI 93 : POINTEUR MPVN.MPOVAL, MPRN.MPOVAL, MPPN.MPOVAL, 94 : & MPGAM.MPOVAL, MPUPRI.MPOVAL, MPUPR2.MPOVAL, MDIAMI.MPOVAL 95 : POINTEUR MELEMC.MELEME 96 : POINTEUR RR.IZAFM, RUX.IZAFM, RUY.IZAFM, RP.IZAFM, 97 : & RUXR.IZAFM, RUXUX.IZAFM, RUXUY.IZAFM, RUXP.IZAFM, 98 : & RUYR.IZAFM, RUYUX.IZAFM, RUYUY.IZAFM, RUYP.IZAFM, 99 : & RETR.IZAFM, RETUX.IZAFM, RETUY.IZAFM, RETP.IZAFM 100 : POINTEUR MLMPRI.MLMOTS, MLMCON.MLMOTS 101 : C 101 : CALL LICHT(IVN,MPVN,TYPE,IGEOM) 101 : CALL LICHT(IRN,MPRN,TYPE,IGEOM) 101 : CALL LICHT(IPN,MPPN,TYPE,IGEOM) 101 : CALL LICHT(IGAMN,MPGAM,TYPE,IGEOM) 101 : CALL LICHT(IUPRI,MPUPRI,TYPE, IGEOM) 101 : CALL LICHT(IUPRI2,MPUPR2,TYPE, IGEOM) 101 : CALL LICHT(IDIAM,MDIAMI,TYPE,IGEOM) 102 : C 103 : C SEGACT MPVN*MOD 104 : C SEGACT MPPN*MOD 105 : C SEGACT MPRN*MOD 106 : C 107 : C**** Maillage des inconnues primales = Maillage des inconnues primales 108 : C = MELEMC 109 : C 110 : C 111 : NRIGE = 7 112 : NMATRI = 1 113 : NKID = 9 114 : NKMT = 7 115 : C 116 : SEGINI MATRIK 117 : IJACO = MATRIK 118 : MATRIK.IRIGEL(1,1) = MELEMC 119 : MATRIK.IRIGEL(2,1) = MELEMC 120 : C 121 : C**** Matrice non symetrique 122 : C 123 : MATRIK.IRIGEL(7,1) = 2 124 : C 125 : NBME = 16 126 : NBSOUS = 1 127 : SEGINI IMATRI 128 : MATRIK.IRIGEL(4,1) = IMATRI 129 : C 130 : SEGACT MLMPRI 131 : IMATRI.LISPRI(1) = MLMPRI.MOTS(1) 132 : IMATRI.LISPRI(2) = MLMPRI.MOTS(2) 133 : IMATRI.LISPRI(3) = MLMPRI.MOTS(3) 134 : IMATRI.LISPRI(4) = MLMPRI.MOTS(4) 135 : IMATRI.LISPRI(5) = MLMPRI.MOTS(1) 136 : IMATRI.LISPRI(6) = MLMPRI.MOTS(2) 137 : IMATRI.LISPRI(7) = MLMPRI.MOTS(3) 138 : IMATRI.LISPRI(8) = MLMPRI.MOTS(4) 139 : IMATRI.LISPRI(9) = MLMPRI.MOTS(1) 140 : IMATRI.LISPRI(10) = MLMPRI.MOTS(2) 141 : IMATRI.LISPRI(11) = MLMPRI.MOTS(3) 142 : IMATRI.LISPRI(12) = MLMPRI.MOTS(4) 143 : IMATRI.LISPRI(13) = MLMPRI.MOTS(1) 144 : IMATRI.LISPRI(14) = MLMPRI.MOTS(2) 145 : IMATRI.LISPRI(15) = MLMPRI.MOTS(3) 146 : IMATRI.LISPRI(16) = MLMPRI.MOTS(4) 147 : SEGDES MLMPRI 148 : C 149 : SEGACT MLMCON 150 : IMATRI.LISDUA(1) = MLMCON.MOTS(1) 151 : IMATRI.LISDUA(2) = MLMCON.MOTS(1) 152 : IMATRI.LISDUA(3) = MLMCON.MOTS(1) 153 : IMATRI.LISDUA(4) = MLMCON.MOTS(1) 154 : IMATRI.LISDUA(5) = MLMCON.MOTS(2) 155 : IMATRI.LISDUA(6) = MLMCON.MOTS(2) 156 : IMATRI.LISDUA(7) = MLMCON.MOTS(2) 157 : IMATRI.LISDUA(8) = MLMCON.MOTS(2) 158 : IMATRI.LISDUA(9) = MLMCON.MOTS(3) 159 : IMATRI.LISDUA(10) = MLMCON.MOTS(3) 160 : IMATRI.LISDUA(11) = MLMCON.MOTS(3) 161 : IMATRI.LISDUA(12) = MLMCON.MOTS(3) 162 : IMATRI.LISDUA(13) = MLMCON.MOTS(4) 163 : IMATRI.LISDUA(14) = MLMCON.MOTS(4) 164 : IMATRI.LISDUA(15) = MLMCON.MOTS(4) 165 : IMATRI.LISDUA(16) = MLMCON.MOTS(4) 166 : SEGDES MLMCON 167 : C 168 : SEGACT MELEMC 169 : NBEL = MELEMC.NUM(/2) 170 : SEGDES MELEMC 171 : NBSOUS = 1 172 : NP = 1 173 : MP = 1 174 : SEGINI RR , RUX , RUY , RP , 175 : & RUXR , RUXUX , RUXUY , RUXP , 176 : & RUYR , RUYUX , RUYUY , RUYP , 177 : & RETR , RETUX , RETUY , RETP 178 : C 179 : C**** Duale = IMATRI.LISDUA(1) = 'RN' 180 : C Primale = IMATRI.LISPRI(4) = 'P' 181 : C -> IMATRI.LIZAFM(1,4) = RP 182 : C 183 : IMATRI.LIZAFM(1,1) = RR 184 : IMATRI.LIZAFM(1,2) = RUX 185 : IMATRI.LIZAFM(1,3) = RUY 186 : IMATRI.LIZAFM(1,4) = RP 187 : IMATRI.LIZAFM(1,5) = RUXR 188 : IMATRI.LIZAFM(1,6) = RUXUX 189 : IMATRI.LIZAFM(1,7) = RUXUY 190 : IMATRI.LIZAFM(1,8) = RUXP 191 : IMATRI.LIZAFM(1,9) = RUYR 192 : IMATRI.LIZAFM(1,10) = RUYUX 193 : IMATRI.LIZAFM(1,11) = RUYUY 194 : IMATRI.LIZAFM(1,12) = RUYP 195 : IMATRI.LIZAFM(1,13) = RETR 196 : IMATRI.LIZAFM(1,14) = RETUX 197 : IMATRI.LIZAFM(1,15) = RETUY 198 : IMATRI.LIZAFM(1,16) = RETP 199 : C 200 : DO ICEN = 1, NBEL, 1 201 : RHO=MPRN.VPOCHA(ICEN,1) 202 : UX=MPVN.VPOCHA(ICEN,1) 203 : UY=MPVN.VPOCHA(ICEN,2) 204 : PN=MPPN.VPOCHA(ICEN,1) 205 : GAMMA=MPGAM.VPOCHA(ICEN,1) 206 : ARS=GAMMA*PN/RHO 207 : AR=ARS**0.5D0 208 : QQ=((UX*UX)+(UY*UY))**0.5D0 209 : UPRI=MPUPRI.VPOCHA(ICEN,1) 210 : UPRI2=MPUPR2.VPOCHA(ICEN,1) 211 : UPRI=MAX(UPRI,UPRI2) 212 : DIAM = MDIAMI.VPOCHA(ICEN,1) 213 : IF(QQ .LT. (EPSIL*UPRI)) THEN 214 : UR = EPSIL*UPRI 215 : ELSE 216 : UR = QQ 217 : ENDIF 218 : IF(UR .GT. AR)THEN 219 : UR=AR 220 : ENDIF 221 : THETA=1.0D0/UR/UR+(GAMMA-1.0D0)/ARS 222 : H=0.5D0*((UX*UX)+(UY*UY))+ARS/(GAMMA-1.0D0) 223 : MM=THETA-GAMMA/ARS 224 : C----- We compute u+a------------ 225 : MREF=UR/AR 226 : MREF2=MREF*MREF 227 : MACH=QQ/AR 228 : MACH2=MACH*MACH 229 : LAMBDA=(1.0D0-MREF2)**2 230 : LAMBDA=(LAMBDA*MACH2)+(4.0D0*MREF2) 231 : LAMBDA=SQRT(LAMBDA)*AR 232 : LAMBDA=((1.0D0+MREF2)*QQ)+LAMBDA 233 : LAMBDA=LAMBDA*0.5D0 234 : DTAUM1=LAMBDA/DIAM 235 : C 236 : C********AB.AM(IFAC,IPRIM,IDUAL) 237 : C A = nom de l'inconnu duale (Ro,rUX,rUY,RET) 238 : C B = nom de l'inconnu primale (Ro,UX,UY,P) 239 : C 240 : C******* Dual RN 241 : C 242 : RR.AM(ICEN,1,1) = 1.0D0*DTAUM1 243 : RUX.AM(ICEN,1,1) = 0.0D0 244 : RUY.AM(ICEN,1,1) = 0.0D0 245 : RP.AM(ICEN,1,1) = MM*DTAUM1 246 : C 247 : C******* Dual RUXN 248 : C 249 : RUXR.AM(ICEN,1,1) = UX*DTAUM1 250 : RUXUX.AM(ICEN,1,1) = RHO*DTAUM1 251 : RUXUY.AM(ICEN,1,1) = 0.0D0 252 : RUXP.AM(ICEN,1,1) = UX*MM*DTAUM1 253 : C 254 : C******* Dual RUYN 255 : C 256 : RUYR.AM(ICEN,1,1) = UY*DTAUM1 257 : RUYUX.AM(ICEN,1,1) = 0.0D0 258 : RUYUY.AM(ICEN,1,1) = RHO*DTAUM1 259 : RUYP.AM(ICEN,1,1) = UY*MM*DTAUM1 260 : C 261 : C********Dual RETN 262 : C 263 : RETR.AM(ICEN,1,1) = 0.5D0*((UX*UX)+(UY*UY))*DTAUM1 264 : RETUX.AM(ICEN,1,1) = RHO*UX*DTAUM1 265 : RETUY.AM(ICEN,1,1) = RHO*UY*DTAUM1 266 : RETP.AM(ICEN,1,1) = (1.0D0/(GAMMA - 1.0D0)+H*MM)*DTAUM1 267 : C 268 : ENDDO 269 : C 270 : SEGDES MPVN 271 : SEGDES MPRN 272 : SEGDES MPGAM 273 : SEGDES MPPN 274 : SEGDES MPUPRI 275 : SEGDES MPUPR2 276 : SEGDES MDIAMI 277 : C 278 : SEGDES MATRIK 279 : SEGDES IMATRI 280 : C 281 : SEGDES RR , RUX , RUY , RP , 282 : & RUXR , RUXUX , RUXUY , RUXP , 283 : & RUYR , RUYUX , RUYUY , RUYP , 284 : & RETR , RETUX , RETUY , RETP 285 : C 286 : RETURN 287 : END 288 : 289 : 290 : 291 : 292 : 293 :
© Cast3M 2003 - All rights reserved.
Disclaimer