Sources Esope | Cast3M

kon18
C KON18     SOURCE    CB215821  20/11/25    13:31:55     10792          
      SUBROUTINE KON18
C************************************************************************
C
C PROJET            :  CASTEM 2000
C
C NOM               :  KON17
C
C DESCRIPTION       :  Subroutine appellée par KON1
C
C                      Modelisation 2D/3D des equations d'Euler
C
C                      Calcul de la Matrix de preconditionnement
C                       pour les variables primitives (rho, u,v,p)
C
C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
C
C AUTEUR            :  A. BECCANTINI, DRN/DMT/SEMT/LTMF
C                      S. Kudriakov , DRN/DMT/SEMT/LTMF
C************************************************************************
C
C APPELES (Calcul)  :
C
C************************************************************************
C
C*** SYNTAXE
C
C  Discrétisation en VF "cell-centered" des équations d'Euler pour
C  un gaz parfait mono-constituent polytropique
C
C  RMAT1 = 'KONV' 'VF' 'PERFMONO' 'GAMPRIM' MAIL1 LMOT1 LMOT2
C          CHPO1 CHPO2 CHPO3 CHPO4 CHPO5 CHPO6 ;
C
C  ENTREES
C
C  LMOT1   : objet de type LISTMOTS
C           Noms de composantes des variable duales de RMAT1.
C           Il contient dans l'ordre suivant: le noms de la densité,
C           du momentum, de l'énergie totale par unité de volume
C
C  LMOT2   : objet de type LISTMOTS
C           Noms de composantes des variable primales de RMAT1.
C           Il contient dans l'ordre suivant: le noms de la densité,
C           de la vitesse, de la pression.
C
C  MAIL1  : SPG
C
C  CHPO0   : CHPOINT contenant le diametre de la cellule (pour le calcul
C           du pas de temps local).
C
C  CHPO1  : CHPOINT contenant la masse volumique
C           (SPG = MAIL1, une seule composante,
C           'SCAL').
C
C  CHPO2  : CHPOINT contenant la vitesse
C           (SPG = MAIL1, deux/trois composantes
C           'UX', 'UY', 'UZ')
C
C  CHPO3  : CHPOINT contenant la pression du gaz
C           (SPG = MAIL1, une seule composante,
C            'SCAL').
C
C  CHPO4  : CHPOINT contenant le "gamma" du gaz
C           (SPG = MAIL1, une seule composante,
C            'SCAL').
C
C  CHPO5  : CHPOINT contenant la vitesse de "cut-off"
C           (SPG = MAIL1, une seule composante,
C            'SCAL').
C
C  CHPO6  : CHPOINT contenant la deuxieme vitesse de "cut-off"
C           (SPG = MAIL1, une seule composante,
C            'SCAL').
C
C SORTIES
C
C  RMAT1  : objet de type MATRIK
C          (SPG =  MAIL1)
C
C************************************************************************
C
C HISTORIQUE (Anomalies et modifications éventuelles)
C
C HISTORIQUE :
C
C************************************************************************
C
      IMPLICIT INTEGER(I-N)
 
-INC PPARAM
-INC CCOPTIO
-INC SMLMOTS
-INC SMCHPOI
-INC SMELEME
      POINTEUR MLMVIT.MLMOTS
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,    IFICLE, IPREFI
C     &        ,MCOORD
C     &        ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
C     &        ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
C     &        ,NORINC,NORVAL,NORIND,NORVAD
C     &        ,NUCROU, IPSAUV
C
      INTEGER IRET, INDIC, NBCOMP, NESP, JGN, JGM
     &     ,MELEMC, IDIAM
     &     ,IJACO, ILIINC, ILIINP, NC
     &     ,IRN, IVN, IPN, IGAMN, IUPRI, IUPRI2
C
      CHARACTER*8 TYPE
      CHARACTER*4 MOT
      CHARACTER*(40) MESERR
C
C*******************************
C**** La table domaine *********
C*******************************
C
      CALL LIROBJ('MAILLAGE',MELEMC,1,IRET)
      IF(IERR .NE. 0)GOTO 9999
C
      NESP=0
C
C**** La list des inconnues duales (variables conservatives)
C
      TYPE='LISTMOTS'
      CALL LIROBJ(TYPE,ILIINC,1,IRET)
      IF(IERR .NE. 0) GOTO 9999
      MLMOTS = ILIINC
      SEGACT MLMOTS
      NC = MLMOTS.MOTS(/2)
      SEGDES MLMOTS
      IF(NC .NE. (IDIM+2+NESP))THEN
         MOTERR(1:40) = 'LISTINCO = ???'
         WRITE(IOIMP,*) MOTERR
C
C******* Message d'erreur standard
C        21 2
C        Données incompatibles
C
         CALL ERREUR(21)
         GOTO 9999
      ENDIF
C
C**** La list des inconnues primales (variables primitives)
C
      TYPE='LISTMOTS'
      CALL LIROBJ(TYPE,ILIINP,1,IRET)
      IF(IERR .NE. 0) GOTO 9999
      MLMOTS = ILIINP
      SEGACT MLMOTS
      NC = MLMOTS.MOTS(/2)
      SEGDES MLMOTS
      IF(NC .NE. (IDIM+2+NESP))THEN
         MOTERR(1:40) = 'LISTINCO = ???'
         WRITE(IOIMP,*) MOTERR
C
C******* Message d'erreur standard
C        21 2
C        Données incompatibles
C
         CALL ERREUR(21)
         GOTO 9999
      ENDIF
C
C**** Lecture du diametre minimum
C
      CALL LIROBJ('CHPOINT',IDIAM,1,IRET)
      IF (IERR.NE.0) GOTO 9999
C
C**** Control du CHPOINT: QUEPOI
C
      INDIC = 1
      NBCOMP = 1
      MOT = 'SCAL'
      CALL QUEPOI(IDIAM, MELEMC, INDIC, NBCOMP, MOT)
C
C**** La densité au centre
C
      TYPE = 'CHPOINT '
      CALL LIROBJ(TYPE,IRN,1,IRET)
      IF(IERR .NE. 0) GOTO 9999
C
C**** Control du CHPOINT: QUEPOI
C
C     INDIC = 1   -> on impose le pointeur du support geometrique (ICEN)
C                   N.B. Le CHPOINT peut changer de structure pour
C                        avoir SPG = ICEN!!!!
C     INDIC = 0   -> on ne fait que verifier le support geometrique
C                   (ICEN). Si le SPG sont differents INDIC = -4 en sortie
C
C     NBCOMP > 0 -> numero des composantes
C
C     MOT  = ' ' obligatoire s'on connais pas les noms des composantes
C
      INDIC = 1
      NBCOMP = 1
      MOT = 'SCAL'
      CALL QUEPOI(IRN, MELEMC, INDIC, NBCOMP, MOT)
      IF(IERR .NE. 0) GOTO 9999
C
C******* La vitesse au centre
C
      TYPE = 'CHPOINT '
      CALL LIROBJ(TYPE,IVN,1,IRET)
      IF(IERR .NE. 0) GOTO 9999
      JGN = 4
      JGM = IDIM
      SEGINI MLMVIT
      MLMVIT.MOTS(1) = 'UX  '
      MLMVIT.MOTS(2) = 'UY  '
      IF(IDIM .EQ. 3) MLMVIT.MOTS(3) = 'UZ  '
      CALL QUEPO1(IVN, MELEMC, MLMVIT)
      SEGSUP MLMVIT
      IF(IERR .NE. 0) GOTO 9999
C
C******* La pression au centre
C
      TYPE = 'CHPOINT '
      CALL LIROBJ(TYPE,IPN,1,IRET)
      IF(IERR .NE. 0) GOTO 9999
      INDIC = 1
      NBCOMP = 1
      MOT = 'SCAL'
      CALL QUEPOI(IPN, MELEMC, INDIC, NBCOMP, MOT)
      IF(IERR .NE. 0) GOTO 9999
C
C******* Gamma au centre
C
      TYPE = 'CHPOINT '
      CALL LIROBJ(TYPE,IGAMN,1,IRET)
      IF(IERR .NE. 0) GOTO 9999
      INDIC = 1
      NBCOMP = 1
      MOT = 'SCAL'
      CALL QUEPOI(IGAMN, MELEMC, INDIC, NBCOMP, MOT)
      IF(IERR .NE. 0) GOTO 9999
C----------------------------------------------------
C******* Vitess de "cut-off" au centre
C----------------------------------------------------
      TYPE = 'CHPOINT '
      CALL LIROBJ(TYPE,IUPRI,1,IRET)
      IF(IERR .NE. 0) GOTO 9999
      INDIC = 1
      NBCOMP = 1
      MOT = 'SCAL'
      CALL QUEPOI(IUPRI, MELEMC, INDIC, NBCOMP, MOT)
      IF(IERR .NE. 0) GOTO 9999
C----------------------------------------------------
C******* Vitess de "cut-off" au centre
C----------------------------------------------------
      TYPE = 'CHPOINT '
      CALL LIROBJ(TYPE,IUPRI2,1,IRET)
      IF(IERR .NE. 0) GOTO 9999
      INDIC = 1
      NBCOMP = 1
      MOT = 'SCAL'
      CALL QUEPOI(IUPRI2, MELEMC, INDIC, NBCOMP, MOT)
      IF(IERR .NE. 0) GOTO 9999
 
C
C******* Calcul du jacobien
C
      IF(IDIM .EQ. 2)THEN
         CALL KON181(MELEMC,IDIAM, ILIINC,ILIINP,IRN,IVN,IPN,IGAMN,
     &               IUPRI,IUPRI2,IJACO)
         IF(IERR .NE. 0) GOTO 9999
      ELSE
         CALL ERREUR(251)
         GOTO 9999
      ENDIF
C
C**** Ecriture des resultats
C
      TYPE='MATRIK '
      CALL ECROBJ(TYPE,IJACO)
 9999 CONTINUE
      RETURN
      END