Sources Esope | Cast3M

prija2
C PRIJA2    SOURCE    CB215821  20/11/25    13:36:50     10792          
      SUBROUTINE PRIJA2(MELEMC,MLMCON,MLMPRI,IRN,IVN,IPN,IGAMN,IJACO)
C
C************************************************************************
C
C PROJET            :  CASTEM 2000
C
C NOM               :  PRIJA2
C
C DESCRIPTION       :  Voir PRIJA1
C                      Cas deux dimensions, gaz "calorically perfect"
C
C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
C
C AUTEUR            :  A. BECCANTINI, DM2S/SFME/LTMF
C
C************************************************************************
C
C ENTREES
C
C     MELEMC   : SPG des CHPOINTs
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     IPN    : CHPOINT CENTRE  contenant la pression
C
C     IGAM   : CHPOINT CENTRE  contenant le gamma
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
C
C**** Variables de COOPTIO
C
C      INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
C     &        ,IOTER,   IOLEC,  IOIMP,     IOCAR,  IOACQ
C     &        ,IOPER,   IOSGB,  IOGRA,     IOSAU,  IORES
C     &        ,IECHO,   IIMPI,  IOSPI
C     &        ,IDIM
C     &        ,MCOORD
C     &        ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
C     &        ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
C     &        ,NORINC,NORVAL,NORIND,NORVAD
C     &        ,NUCROU, IPSAUV, IFICLE, IPREFI
C
      IMPLICIT INTEGER(I-N)
      INTEGER  IRN, IVN, IPN, IGAMN, IJACO, IGEOM, ICEN
     &       , MP, NP,  NBEL, NBME, NBSOUS
     &       , NRIGE, NMATRI, NKID, NKMT
C
      REAL*8 RHO,UX, UY, UZ, GAMMA
      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, MPGAM.MPOVAL
      POINTEUR MELEMC.MELEME
      POINTEUR RR.IZAFM, RUX.IZAFM, RUY.IZAFM, RUZ.IZAFM, RP.IZAFM,
     &         UXR.IZAFM, UXUX.IZAFM, UXUY.IZAFM, UXUZ.IZAFM,
     &         UXP.IZAFM,
     &         UYR.IZAFM, UYUX.IZAFM, UYUY.IZAFM, UYUZ.IZAFM,
     &         UYP.IZAFM,
     &         UZR.IZAFM, UZUX.IZAFM, UZUY.IZAFM, UZUZ.IZAFM,
     &         UZP.IZAFM,
     &         RETR.IZAFM, RETUX.IZAFM, RETUY.IZAFM, RETUZ.IZAFM,
     &         RETP.IZAFM
      POINTEUR MLMPRI.MLMOTS, MLMCON.MLMOTS
C
      CALL LICHT(IVN,MPVN,TYPE,IGEOM)
      CALL LICHT(IRN,MPRN,TYPE,IGEOM)
      CALL LICHT(IGAMN,MPGAM,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 = 25
      NBSOUS = 1
      SEGINI IMATRI
      MATRIK.IRIGEL(4,1) = IMATRI
C
      SEGACT MLMPRI
C-----------------------------------------------
      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(5)
C-----------------------------------------------
      IMATRI.LISPRI(6) = MLMPRI.MOTS(1)
      IMATRI.LISPRI(7) = MLMPRI.MOTS(2)
      IMATRI.LISPRI(8) = MLMPRI.MOTS(3)
      IMATRI.LISPRI(9) = MLMPRI.MOTS(4)
      IMATRI.LISPRI(10) = MLMPRI.MOTS(5)
C-----------------------------------------------
      IMATRI.LISPRI(11) = MLMPRI.MOTS(1)
      IMATRI.LISPRI(12) = MLMPRI.MOTS(2)
      IMATRI.LISPRI(13) = MLMPRI.MOTS(3)
      IMATRI.LISPRI(14) = MLMPRI.MOTS(4)
      IMATRI.LISPRI(15) = MLMPRI.MOTS(5)
C-----------------------------------------------
      IMATRI.LISPRI(16) = MLMPRI.MOTS(1)
      IMATRI.LISPRI(17) = MLMPRI.MOTS(2)
      IMATRI.LISPRI(18) = MLMPRI.MOTS(3)
      IMATRI.LISPRI(19) = MLMPRI.MOTS(4)
      IMATRI.LISPRI(20) = MLMPRI.MOTS(5)
C-----------------------------------------------
      IMATRI.LISPRI(21) = MLMPRI.MOTS(1)
      IMATRI.LISPRI(22) = MLMPRI.MOTS(2)
      IMATRI.LISPRI(23) = MLMPRI.MOTS(3)
      IMATRI.LISPRI(24) = MLMPRI.MOTS(4)
      IMATRI.LISPRI(25) = MLMPRI.MOTS(5)
C-----------------------------------------------
      SEGDES MLMPRI
C
      SEGACT MLMCON
C-----------------------------------------------
      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(1)
C-----------------------------------------------
      IMATRI.LISDUA(6) = MLMCON.MOTS(2)
      IMATRI.LISDUA(7) = MLMCON.MOTS(2)
      IMATRI.LISDUA(8) = MLMCON.MOTS(2)
      IMATRI.LISDUA(9) = MLMCON.MOTS(2)
      IMATRI.LISDUA(10) = MLMCON.MOTS(2)
C-----------------------------------------------
      IMATRI.LISDUA(11) = MLMCON.MOTS(3)
      IMATRI.LISDUA(12) = MLMCON.MOTS(3)
      IMATRI.LISDUA(13) = MLMCON.MOTS(3)
      IMATRI.LISDUA(14) = MLMCON.MOTS(3)
      IMATRI.LISDUA(15) = MLMCON.MOTS(3)
C-----------------------------------------------
      IMATRI.LISDUA(16) = MLMCON.MOTS(4)
      IMATRI.LISDUA(17) = MLMCON.MOTS(4)
      IMATRI.LISDUA(18) = MLMCON.MOTS(4)
      IMATRI.LISDUA(19) = MLMCON.MOTS(4)
      IMATRI.LISDUA(20) = MLMCON.MOTS(4)
C-----------------------------------------------
      IMATRI.LISDUA(21) = MLMCON.MOTS(5)
      IMATRI.LISDUA(22) = MLMCON.MOTS(5)
      IMATRI.LISDUA(23) = MLMCON.MOTS(5)
      IMATRI.LISDUA(24) = MLMCON.MOTS(5)
      IMATRI.LISDUA(25) = MLMCON.MOTS(5)
C-----------------------------------------------
      SEGDES MLMCON
C
      SEGACT MELEMC
      NBEL = MELEMC.NUM(/2)
      SEGDES MELEMC
      NBSOUS = 1
      NP = 1
      MP = 1
      SEGINI   RR  , RUX , RUY , RUZ, RP ,
     &         UXR , UXUX , UXUY , UXUZ, UXP ,
     &         UYR , UYUX , UYUY , UYUZ, UYP ,
     &         UZR , UZUX , UZUY , UZUZ, UZP ,
     &         RETR , RETUX , RETUY , RETUZ, RETP
C
C**** Duale = IMATRI.LISDUA(1) = 'RN'
C     Primale = IMATRI.LISPRI(4) = 'P'
C     -> IMATRI.LIZAFM(1,4) = RP
C
C-----------------------------------------------
      IMATRI.LIZAFM(1,1) = RR
      IMATRI.LIZAFM(1,2) = RUX
      IMATRI.LIZAFM(1,3) = RUY
      IMATRI.LIZAFM(1,4) = RUZ
      IMATRI.LIZAFM(1,5) = RP
C-----------------------------------------------
      IMATRI.LIZAFM(1,6) = UXR
      IMATRI.LIZAFM(1,7) = UXUX
      IMATRI.LIZAFM(1,8) = UXUY
      IMATRI.LIZAFM(1,9) = UXUZ
      IMATRI.LIZAFM(1,10) = UXP
C-----------------------------------------------
      IMATRI.LIZAFM(1,11) = UYR
      IMATRI.LIZAFM(1,12) = UYUX
      IMATRI.LIZAFM(1,13) = UYUY
      IMATRI.LIZAFM(1,14) = UYUZ
      IMATRI.LIZAFM(1,15) = UYP
C------------------------------------------------
      IMATRI.LIZAFM(1,16) = UZR
      IMATRI.LIZAFM(1,17) = UZUX
      IMATRI.LIZAFM(1,18) = UZUY
      IMATRI.LIZAFM(1,19) = UZUZ
      IMATRI.LIZAFM(1,20) = UZP
C-----------------------------------------------
      IMATRI.LIZAFM(1,21) = RETR
      IMATRI.LIZAFM(1,22) = RETUX
      IMATRI.LIZAFM(1,23) = RETUY
      IMATRI.LIZAFM(1,24) = RETUZ
      IMATRI.LIZAFM(1,25) = RETP
C-----------------------------------------------
C
      DO ICEN = 1, NBEL, 1
         RHO=MPRN.VPOCHA(ICEN,1)
         UX=MPVN.VPOCHA(ICEN,1)
         UY=MPVN.VPOCHA(ICEN,2)
         UZ=MPVN.VPOCHA(ICEN,3)
         GAMMA=MPGAM.VPOCHA(ICEN,1)
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
         RUX.AM(ICEN,1,1) = 0.0D0
         RUY.AM(ICEN,1,1) = 0.0D0
         RUZ.AM(ICEN,1,1) = 0.0D0
         RP.AM(ICEN,1,1)  = 0.0D0
C
C******* Dual RUXN
C
         UXR.AM(ICEN,1,1) = UX
         UXUX.AM(ICEN,1,1) = RHO
         UXUY.AM(ICEN,1,1) = 0.0D0
         UXUZ.AM(ICEN,1,1) = 0.0D0
         UXP.AM(ICEN,1,1) = 0.0D0
C
C******* Dual RUYN
C
         UYR.AM(ICEN,1,1) = UY
         UYUX.AM(ICEN,1,1) = 0.0D0
         UYUY.AM(ICEN,1,1) = RHO
         UYUZ.AM(ICEN,1,1) = 0.0D0
         UYP.AM(ICEN,1,1) = 0.0D0
C
C******* Dual RUZN
C
         UZR.AM(ICEN,1,1) = UZ
         UZUX.AM(ICEN,1,1) = 0.0D0
         UZUY.AM(ICEN,1,1) = 0.0D0
         UZUZ.AM(ICEN,1,1) = RHO
         UZP.AM(ICEN,1,1) = 0.0D0
C
C********Dual RETN
C
         RETR.AM(ICEN,1,1) = 0.5D0*((UX*UX)+(UY*UY)+(UZ*UZ))
         RETUX.AM(ICEN,1,1) = RHO*UX
         RETUY.AM(ICEN,1,1) = RHO*UY
         RETUZ.AM(ICEN,1,1) = RHO*UZ
         RETP.AM(ICEN,1,1) = 1.0D0/(GAMMA - 1.0D0)
C
      ENDDO
C
      SEGDES MPVN
      SEGDES MPRN
      SEGDES MPGAM
C
      SEGDES MATRIK
      SEGDES IMATRI
C
      SEGINI   RR  , RUX , RUY , RUZ, RP ,
     &         UXR , UXUX , UXUY , UXUZ, UXP ,
     &         UYR , UYUX , UYUY , UYUZ, UYP ,
     &         UZR , UZUX , UZUY , UZUZ, UZP ,
     &         RETR , RETUX , RETUY , RETUZ, RETP
C
      RETURN
      END