C KON181 SOURCE OF166741 24/12/13 21:16:17 12097 SUBROUTINE KON181(MELEMC,IDIAM,MLMCON,MLMPRI,IRN,IVN,IPN,IGAMN, & IUPRI,IUPRI2,IJACO) C C************************************************************************ C C PROJET : CASTEM 2000 C C NOM : KON181 C C DESCRIPTION : Voir KON18 C Cas deux dimensions, gaz "calorically perfect" C C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI) C C AUTEUR : Chezarovich , DM2S/SFME/LTMF C S. Kudriakov, DM2S/SFME/LTMF C************************************************************************ C C ENTREES C C MELEMC : SPG des CHPOINTs C C IDIAM : diametre de l'elt C C MLMPRI : liste des inconnues primitives (P,v,T) C C MLMCON : liste des inconnues conservatives (rho, rhov, rhoet) C C IRN : CHPOINT CENTRE contenant la densité C C IVN : CHPOINT CENTRE contenant la vitesse C C IVN : CHPOINT CENTRE contenant la pression C C IGAM : CHPOINT CENTRE contenant le gamma C C IUPRI : CHPOINT CENTRE contenant la vitesse "cut-off" C C IUPRI2 : CHPOINT CENTRE contenant la vitesse "cut-off" C C SORTIES C C IJACO : pointeur de la MATRIK jacobienne C C************************************************************************ C C HISTORIQUE (Anomalies et modifications éventuelles) C C HISTORIQUE : crée le 29.05.02 C C************************************************************************ C C C N.B.: On suppose qu'on a déjà controllé RO, P > 0 C GAMMA \in (1,3) C Si non il faut le faire!!! C C************************************************************************ C IMPLICIT INTEGER(I-N) INTEGER IRN, IVN, IPN, IGAMN, IJACO, IGEOM, ICEN & , MP, NP, NBEL, NBME, NBSOUS, IUPRI, IUPRI2 & , NRIGE, NMATRI, NKID, NKMT, IDIAM C REAL*8 RHO,UX, UY, GAMMA, PN, ARS, UR, THETA, H, MM, EPSIL, QQ & ,AR, UPRI, UPRI2, DIAM, LAMBDA, MREF, MREF2, MACH, MACH2 & ,DTAUM1 PARAMETER(EPSIL=1.0D0) CHARACTER*8 TYPE C C**** LES INCLUDES C -INC PPARAM -INC CCOPTIO -INC SMCHPOI -INC SMMATRIK -INC SMELEME -INC SMLMOTS -INC SMLENTI POINTEUR MPVN.MPOVAL, MPRN.MPOVAL, MPPN.MPOVAL, & MPGAM.MPOVAL, MPUPRI.MPOVAL, MPUPR2.MPOVAL, MDIAMI.MPOVAL POINTEUR MELEMC.MELEME POINTEUR RR.IZAFM, RUX.IZAFM, RUY.IZAFM, RP.IZAFM, & RUXR.IZAFM, RUXUX.IZAFM, RUXUY.IZAFM, RUXP.IZAFM, & RUYR.IZAFM, RUYUX.IZAFM, RUYUY.IZAFM, RUYP.IZAFM, & RETR.IZAFM, RETUX.IZAFM, RETUY.IZAFM, RETP.IZAFM POINTEUR MLMPRI.MLMOTS, MLMCON.MLMOTS C CALL LICHT(IVN,MPVN,TYPE,IGEOM) CALL LICHT(IRN,MPRN,TYPE,IGEOM) CALL LICHT(IPN,MPPN,TYPE,IGEOM) CALL LICHT(IGAMN,MPGAM,TYPE,IGEOM) CALL LICHT(IUPRI,MPUPRI,TYPE, IGEOM) CALL LICHT(IUPRI2,MPUPR2,TYPE, IGEOM) CALL LICHT(IDIAM,MDIAMI,TYPE,IGEOM) C C SEGACT MPVN*MOD C SEGACT MPPN*MOD C SEGACT MPRN*MOD C C**** Maillage des inconnues primales = Maillage des inconnues primales C = MELEMC C C NRIGE = 7 NMATRI = 1 NKID = 9 NKMT = 7 C SEGINI MATRIK IJACO = MATRIK MATRIK.IRIGEL(1,1) = MELEMC MATRIK.IRIGEL(2,1) = MELEMC C C**** Matrice non symetrique C MATRIK.IRIGEL(7,1) = 2 C NBME = 16 NBSOUS = 1 SEGINI IMATRI MATRIK.IRIGEL(4,1) = IMATRI C SEGACT MLMPRI IMATRI.LISPRI(1) = MLMPRI.MOTS(1) IMATRI.LISPRI(2) = MLMPRI.MOTS(2) IMATRI.LISPRI(3) = MLMPRI.MOTS(3) IMATRI.LISPRI(4) = MLMPRI.MOTS(4) IMATRI.LISPRI(5) = MLMPRI.MOTS(1) IMATRI.LISPRI(6) = MLMPRI.MOTS(2) IMATRI.LISPRI(7) = MLMPRI.MOTS(3) IMATRI.LISPRI(8) = MLMPRI.MOTS(4) IMATRI.LISPRI(9) = MLMPRI.MOTS(1) IMATRI.LISPRI(10) = MLMPRI.MOTS(2) IMATRI.LISPRI(11) = MLMPRI.MOTS(3) IMATRI.LISPRI(12) = MLMPRI.MOTS(4) IMATRI.LISPRI(13) = MLMPRI.MOTS(1) IMATRI.LISPRI(14) = MLMPRI.MOTS(2) IMATRI.LISPRI(15) = MLMPRI.MOTS(3) IMATRI.LISPRI(16) = MLMPRI.MOTS(4) SEGDES MLMPRI C SEGACT MLMCON IMATRI.LISDUA(1) = MLMCON.MOTS(1) IMATRI.LISDUA(2) = MLMCON.MOTS(1) IMATRI.LISDUA(3) = MLMCON.MOTS(1) IMATRI.LISDUA(4) = MLMCON.MOTS(1) IMATRI.LISDUA(5) = MLMCON.MOTS(2) IMATRI.LISDUA(6) = MLMCON.MOTS(2) IMATRI.LISDUA(7) = MLMCON.MOTS(2) IMATRI.LISDUA(8) = MLMCON.MOTS(2) IMATRI.LISDUA(9) = MLMCON.MOTS(3) IMATRI.LISDUA(10) = MLMCON.MOTS(3) IMATRI.LISDUA(11) = MLMCON.MOTS(3) IMATRI.LISDUA(12) = MLMCON.MOTS(3) IMATRI.LISDUA(13) = MLMCON.MOTS(4) IMATRI.LISDUA(14) = MLMCON.MOTS(4) IMATRI.LISDUA(15) = MLMCON.MOTS(4) IMATRI.LISDUA(16) = MLMCON.MOTS(4) SEGDES MLMCON C SEGACT MELEMC NBEL = MELEMC.NUM(/2) SEGDES MELEMC NBSOUS = 1 NP = 1 MP = 1 SEGINI RR , RUX , RUY , RP , & RUXR , RUXUX , RUXUY , RUXP , & RUYR , RUYUX , RUYUY , RUYP , & RETR , RETUX , RETUY , RETP C C**** Duale = IMATRI.LISDUA(1) = 'RN' C Primale = IMATRI.LISPRI(4) = 'P' C -> IMATRI.LIZAFM(1,4) = RP C IMATRI.LIZAFM(1,1) = RR IMATRI.LIZAFM(1,2) = RUX IMATRI.LIZAFM(1,3) = RUY IMATRI.LIZAFM(1,4) = RP IMATRI.LIZAFM(1,5) = RUXR IMATRI.LIZAFM(1,6) = RUXUX IMATRI.LIZAFM(1,7) = RUXUY IMATRI.LIZAFM(1,8) = RUXP IMATRI.LIZAFM(1,9) = RUYR IMATRI.LIZAFM(1,10) = RUYUX IMATRI.LIZAFM(1,11) = RUYUY IMATRI.LIZAFM(1,12) = RUYP IMATRI.LIZAFM(1,13) = RETR IMATRI.LIZAFM(1,14) = RETUX IMATRI.LIZAFM(1,15) = RETUY IMATRI.LIZAFM(1,16) = RETP C DO ICEN = 1, NBEL, 1 RHO=MPRN.VPOCHA(ICEN,1) UX=MPVN.VPOCHA(ICEN,1) UY=MPVN.VPOCHA(ICEN,2) PN=MPPN.VPOCHA(ICEN,1) GAMMA=MPGAM.VPOCHA(ICEN,1) ARS=GAMMA*PN/RHO AR=ARS**0.5D0 QQ=((UX*UX)+(UY*UY))**0.5D0 UPRI=MPUPRI.VPOCHA(ICEN,1) UPRI2=MPUPR2.VPOCHA(ICEN,1) UPRI=MAX(UPRI,UPRI2) DIAM = MDIAMI.VPOCHA(ICEN,1) IF(QQ .LT. (EPSIL*UPRI)) THEN UR = EPSIL*UPRI ELSE UR = QQ ENDIF IF(UR .GT. AR)THEN UR=AR ENDIF THETA=1.0D0/UR/UR+(GAMMA-1.0D0)/ARS H=0.5D0*((UX*UX)+(UY*UY))+ARS/(GAMMA-1.0D0) MM=THETA-GAMMA/ARS C----- We compute u+a------------ MREF=UR/AR MREF2=MREF*MREF MACH=QQ/AR MACH2=MACH*MACH LAMBDA=(1.0D0-MREF2)**2 LAMBDA=(LAMBDA*MACH2)+(4.0D0*MREF2) LAMBDA=SQRT(LAMBDA)*AR LAMBDA=((1.0D0+MREF2)*QQ)+LAMBDA LAMBDA=LAMBDA*0.5D0 DTAUM1=LAMBDA/DIAM C C********AB.AM(IFAC,IPRIM,IDUAL) C A = nom de l'inconnu duale (Ro,rUX,rUY,RET) C B = nom de l'inconnu primale (Ro,UX,UY,P) C C******* Dual RN C RR.AM(ICEN,1,1) = 1.0D0*DTAUM1 RUX.AM(ICEN,1,1) = 0.0D0 RUY.AM(ICEN,1,1) = 0.0D0 RP.AM(ICEN,1,1) = MM*DTAUM1 C C******* Dual RUXN C RUXR.AM(ICEN,1,1) = UX*DTAUM1 RUXUX.AM(ICEN,1,1) = RHO*DTAUM1 RUXUY.AM(ICEN,1,1) = 0.0D0 RUXP.AM(ICEN,1,1) = UX*MM*DTAUM1 C C******* Dual RUYN C RUYR.AM(ICEN,1,1) = UY*DTAUM1 RUYUX.AM(ICEN,1,1) = 0.0D0 RUYUY.AM(ICEN,1,1) = RHO*DTAUM1 RUYP.AM(ICEN,1,1) = UY*MM*DTAUM1 C C********Dual RETN C RETR.AM(ICEN,1,1) = 0.5D0*((UX*UX)+(UY*UY))*DTAUM1 RETUX.AM(ICEN,1,1) = RHO*UX*DTAUM1 RETUY.AM(ICEN,1,1) = RHO*UY*DTAUM1 RETP.AM(ICEN,1,1) = (1.0D0/(GAMMA - 1.0D0)+H*MM)*DTAUM1 C ENDDO C SEGDES MPVN SEGDES MPRN SEGDES MPGAM SEGDES MPPN SEGDES MPUPRI SEGDES MPUPR2 SEGDES MDIAMI C SEGDES MATRIK SEGDES IMATRI C SEGDES RR , RUX , RUY , RP , & RUXR , RUXUX , RUXUY , RUXP , & RUYR , RUYUX , RUYUY , RUYP , & RETR , RETUX , RETUY , RETP C RETURN END