Sources Esope | Cast3M

kon171
C KON171    SOURCE    CB215821  20/11/25    13:31:54     10792          
      SUBROUTINE KON171(ICEN,IDIAMI,IRN,IUN,IPN,IGAMN,ILINC,IUPRI1,
     $     IUPRI2,IMAT)
C
C************************************************************************
C
C PROJET            :  CASTEM 2000
C
C NOM               :  KON171
C
C DESCRIPTION       :  Voir KON17
C                      Calcul de la matrice de preconditionnement
C                      \Gamma pour les variables conservatives
C
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                      S. V. KUDRIAKOV, DM2S/SFME/LTMF
C
C************************************************************************
C
C
C APPELES (Outils
C          CASTEM)  :
C
C APPELES (Calcul)  :
C
C************************************************************************
C
C ENTREES
C
C     ILINC  : liste des inconnues (pointeur d'un objet de type LISTMOTS)
C
C  1) Pointeurs de MELEME de la table DOMAINE
C
C     ICEN    : MELEME 'CENTRE' du SPG des CENTRES
C
C     IDIAMI  : CHPOINT CENTRE  contenant le diametre de la cellule ;
C
C  2) Pointeurs des CHPOINT
C
C     IRN     : CHPOINT CENTRE  contenant la masse volumique ;
C
C     IUN     : CHPOINT CENTRE  contenant la vitesse ;
C
C     IPN     : CHPOINT CENTRE  contenant la pression ;
C
C     IGAMN   : CHPOINT CENTRE  contenant le gamma ;
C
C     IUPRI1  : CHPOINT CENTRE  contenant la vitesse de "cut-off" ;
C
C     IUPRI2  : CHPOINT CENTRE  contenant la vitesse de "cut-off" ;
C
C SORTIES
C
C     IMAT    : pointeur de la MATRIK du \Gamma
C
C************************************************************************
C
C HISTORIQUE (Anomalies et modifications éventuelles)
C
C HISTORIQUE :
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 IGEOMC, IDIAMI
     &       ,ILINC ,IRN ,IUN ,IPN ,IGAMN, IMAT
     &       ,NBELEM, ICEN, IUPRI1, IUPRI2
     &       ,MP,NBEL,NBME,NBSOUS,NKID,NKMT,NMATRI,NP,NRIGE
C
      REAL*8 WVECT(4), GAM, GMT(4,4), VPRI, VPRI2, DIAM
      CHARACTER*8 TYPE
C
C**** LES INCLUDES
C
 
-INC PPARAM
-INC CCOPTIO
-INC SMCHPOI
-INC SMMATRIK
-INC SMELEME
-INC SMLMOTS
-INC SMLENTI
      POINTEUR MPRN.MPOVAL, MPUN.MPOVAL, MPPN.MPOVAL, MPGAMN.MPOVAL,
     &         MPUPR1.MPOVAL,MPUPR2.MPOVAL,MDIAMI.MPOVAL
      POINTEUR MELEMC.MELEME
      POINTEUR RR.IZAFM, RUX.IZAFM, RUY.IZAFM, RRET.IZAFM,
     &         UXR.IZAFM, UXUX.IZAFM, UXUY.IZAFM, UXRET.IZAFM,
     &         UYR.IZAFM, UYUX.IZAFM, UYUY.IZAFM, UYRET.IZAFM,
     &         RETR.IZAFM, RETUX.IZAFM, RETUY.IZAFM, RETRET.IZAFM
      POINTEUR MLMINC.MLMOTS
C
      MELEMC=ICEN
      SEGACT MELEMC
      NBELEM =MELEMC.NUM(/2)
      SEGDES MELEMC
C
      CALL LICHT(IRN,MPRN,TYPE,IGEOMC)
      CALL LICHT(IPN,MPPN,TYPE,IGEOMC)
      CALL LICHT(IUN,MPUN,TYPE,IGEOMC)
      CALL LICHT(IGAMN,MPGAMN,TYPE,IGEOMC)
      CALL LICHT(IUPRI1,MPUPR1,TYPE,IGEOMC)
      CALL LICHT(IUPRI2,MPUPR2,TYPE,IGEOMC)
      CALL LICHT(IDIAMI,MDIAMI,TYPE,IGEOMC)
C
C     SEGACT MPRN*MOD
C     SEGACT MPPN*MOD
C     SEGACT MPUN*MOD
C     SEGACT MPGAMN*MOD
C
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
      IMAT = 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
      MLMINC = ILINC
      SEGACT MLMINC
      MATRIK.IRIGEL(4,1) = IMATRI
C
      IMATRI.LISPRI(1) = MLMINC.MOTS(1)
      IMATRI.LISPRI(2) = MLMINC.MOTS(2)
      IMATRI.LISPRI(3) = MLMINC.MOTS(3)
      IMATRI.LISPRI(4) = MLMINC.MOTS(4)
      IMATRI.LISPRI(5) = MLMINC.MOTS(1)
      IMATRI.LISPRI(6) = MLMINC.MOTS(2)
      IMATRI.LISPRI(7) = MLMINC.MOTS(3)
      IMATRI.LISPRI(8) = MLMINC.MOTS(4)
      IMATRI.LISPRI(9) = MLMINC.MOTS(1)
      IMATRI.LISPRI(10) = MLMINC.MOTS(2)
      IMATRI.LISPRI(11) = MLMINC.MOTS(3)
      IMATRI.LISPRI(12) = MLMINC.MOTS(4)
      IMATRI.LISPRI(13) = MLMINC.MOTS(1)
      IMATRI.LISPRI(14) = MLMINC.MOTS(2)
      IMATRI.LISPRI(15) = MLMINC.MOTS(3)
      IMATRI.LISPRI(16) = MLMINC.MOTS(4)
C
      IMATRI.LISDUA(1) = MLMINC.MOTS(1)
      IMATRI.LISDUA(2) = MLMINC.MOTS(1)
      IMATRI.LISDUA(3) = MLMINC.MOTS(1)
      IMATRI.LISDUA(4) = MLMINC.MOTS(1)
      IMATRI.LISDUA(5) = MLMINC.MOTS(2)
      IMATRI.LISDUA(6) = MLMINC.MOTS(2)
      IMATRI.LISDUA(7) = MLMINC.MOTS(2)
      IMATRI.LISDUA(8) = MLMINC.MOTS(2)
      IMATRI.LISDUA(9) = MLMINC.MOTS(3)
      IMATRI.LISDUA(10) = MLMINC.MOTS(3)
      IMATRI.LISDUA(11) = MLMINC.MOTS(3)
      IMATRI.LISDUA(12) = MLMINC.MOTS(3)
      IMATRI.LISDUA(13) = MLMINC.MOTS(4)
      IMATRI.LISDUA(14) = MLMINC.MOTS(4)
      IMATRI.LISDUA(15) = MLMINC.MOTS(4)
      IMATRI.LISDUA(16) = MLMINC.MOTS(4)
C
      NBEL = NBELEM
      NBSOUS = 1
      NP = 1
      MP = 1
      SEGINI   RR  , RUX , RUY , RRET ,
     &         UXR , UXUX , UXUY , UXRET ,
     &         UYR , UYUX , UYUY , UYRET ,
     &         RETR , RETUX , RETUY , RETRET
C
C**** Duale = IMATRI.LISDUA(1) = 'RN'
C     Primale = IMATRI.LISPRI(1) = 'RN'
C     -> IMATRI.LIZAFM(1,1) = RR
C
C     Duale = IMATRI.LISDUA(2) = 'RN'
C     Primale = IMATRI.LISPRI(1) = 'UXN'
C     -> IMATRI.LIZAFM(1,2) = RUX
C     ...
C
      IMATRI.LIZAFM(1,1) = RR
      IMATRI.LIZAFM(1,2) = RUX
      IMATRI.LIZAFM(1,3) = RUY
      IMATRI.LIZAFM(1,4) = RRET
      IMATRI.LIZAFM(1,5) = UXR
      IMATRI.LIZAFM(1,6) = UXUX
      IMATRI.LIZAFM(1,7) = UXUY
      IMATRI.LIZAFM(1,8) = UXRET
      IMATRI.LIZAFM(1,9) = UYR
      IMATRI.LIZAFM(1,10) = UYUX
      IMATRI.LIZAFM(1,11) = UYUY
      IMATRI.LIZAFM(1,12) = UYRET
      IMATRI.LIZAFM(1,13) = RETR
      IMATRI.LIZAFM(1,14) = RETUX
      IMATRI.LIZAFM(1,15) = RETUY
      IMATRI.LIZAFM(1,16) = RETRET
C
      DO ICEN = 1, NBELEM, 1
C
         WVECT(1)= MPRN.VPOCHA(ICEN,1)
         WVECT(4)=MPPN.VPOCHA(ICEN,1)
         WVECT(2)=MPUN.VPOCHA(ICEN,1)
         WVECT(3)=MPUN.VPOCHA(ICEN,2)
         GAM = MPGAMN.VPOCHA(ICEN,1)
         DIAM = MDIAMI.VPOCHA(ICEN,1)
C
C******* Le calcul
C
         VPRI= MPUPR1.VPOCHA(ICEN,1)
         VPRI2= MPUPR2.VPOCHA(ICEN,1)
         VPRI=MAX(VPRI,VPRI2)
         CALL GMAT2D(GMT,WVECT,GAM,VPRI,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,rUX,rUY,RET)
C        IPRIM = 1
C        IDUAL = 1
C        i.e.
C        A_IDUAL = AB.AM(IFAC,IPRIM,IDUAL) * B_IPRIM + ...
C
C
C        N.B. GMT parcoru à l'inverse par rapport au stokage
C             en Fortran
C
C******* Dual RN
C
         RR.AM(ICEN,1,1) = GMT(1,1)
         RUX.AM(ICEN,1,1) = GMT(1,2)
         RUY.AM(ICEN,1,1) = GMT(1,3)
         RRET.AM(ICEN,1,1) = GMT(1,4)
C
C******* Dual RUXN
C
         UXR.AM(ICEN,1,1) = GMT(2,1)
         UXUX.AM(ICEN,1,1) = GMT(2,2)
         UXUY.AM(ICEN,1,1) = GMT(2,3)
         UXRET.AM(ICEN,1,1) = GMT(2,4)
C
C******* Dual RUYN
C
         UYR.AM(ICEN,1,1) = GMT(3,1)
         UYUX.AM(ICEN,1,1) = GMT(3,2)
         UYUY.AM(ICEN,1,1) = GMT(3,3)
         UYRET.AM(ICEN,1,1) = GMT(3,4)
C
C********Dual RETN
C
         RETR.AM(ICEN,1,1) = GMT(4,1)
         RETUX.AM(ICEN,1,1) = GMT(4,2)
         RETUY.AM(ICEN,1,1) = GMT(4,3)
         RETRET.AM(ICEN,1,1) = GMT(4,4)
C
      ENDDO
C
      SEGDES MELEMC
C
      SEGDES MPRN
      SEGDES MPPN
      SEGDES MPUN
      SEGDES MPGAMN
      SEGDES MPUPR1
      SEGDES MPUPR2
      SEGDES MDIAMI
C
      SEGDES MATRIK
      SEGDES IMATRI
C
      SEGDES   RR  , RUX , RUY , RRET ,
     &         UXR , UXUX , UXUY , UXRET ,
     &         UYR , UYUX , UYUY , UYRET ,
     &         RETR , RETUX , RETUY , RETRET
C
      SEGDES MLMINC
C
 9999 CONTINUE
      RETURN
      END