Sources Esope | Cast3M

kon17
C KON17     SOURCE    OF166741  24/12/13    21:16:16     12097          
      SUBROUTINE KON17
C
C************************************************************************
C
C PROJET            :  CASTEM 2000
C
C NOM               :  KON17
C
C DESCRIPTION       :  Voir KON1
C                      Matrice de prconditionnement pour le variables
C                      conservatives sous la forme d'un objet
C                      elementaire de type MATRIK
C
C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
C
C AUTEUR            :  A. BECCANTINI, DM2S/SFME/LTMF
C
C************************************************************************
C
C
C APPELES (Outils)  :
C
C APPELES (Calcul)  :
C
C
C************************************************************************
C
C PHRASE D'APPELLE GIBIANE
C
C MAT1 = 'KONV' 'VF' 'PERFMONO' 'GAMMCONS' LMOT1 MAIL1 CHPO1 CHPO2 CHPO3
C         CHPO4 CHPO5 CHPO6 ;
C
C LMOT1   : objet de type LISTMOTS
C           Noms des variables conservatives
C           Il contient dans l'ordre suivant: le noms de la densité,
C           de la vitesse, de l'énergie totale par unité de volume
C
C MAIL1   : maillage, SPG des champoints suivants
C
C CHPO0   : CHPOINT contenant le diametre de la cellule (pour le calcule
C           du pas de temps local).
C
C CHPO1   : CHPOINT contenant la masse volumique
C           (SPG = MAIL1 des elts une seule composante,
C            'SCAL').
C
C CHPO2   : CHPOINT contenant la vitesse
C           (SPG = MAIL1 des elts, deux/trois composantes
C            'UX', 'UY', 'UZ')
C
C CHPO3   : CHPOINT contenant la pression du gaz
C           (SPG = MAIL1 des elts, une seule composante,
C            'SCAL').
C
C CHPO4   : CHPOINT contenant le "gamma" du gaz
C           (SPG = MAIL1 des elts, une seule composante,
C            'SCAL').
C
C CHPO5   : CHPOINT contenant la premiere vitesse de cut-off
C            (SPG = MAIL1 des elts, une seule composante,
C            'SCAL').
C
C CHPO6   : CHPOINT contenant la deuxieme vitesse de cut-off
C            (SPG = MAIL1 des elts, une seule composante,
C            'SCAL').
C
C SORTIE
C
C MAT1    : objet de type MATRIK, qui contient la matrice gamma
C          (divisé par le pas de temps locale;
C          le pas de temps est calculé pour le système preconditionnné)
C
C************************************************************************
C
C HISTORIQUE (Anomalies et modifications éventuelles)
C
C HISTORIQUE :
C
C************************************************************************
C
      IMPLICIT INTEGER(I-N)
      INTEGER ILIINC, IRET, NC, ICOND, IERR0, INDIC, JGN, JGM
     &     ,IRN,NBCOMP,IVN,IPN,IGAMN,IGMAT,IUPRI1,IUPRI2
     &     ,NBSOUS,NTYP,IGEOM,IDIAM
      CHARACTER*8 TYPE
      CHARACTER*4 MOT(1)
C
-INC PPARAM
-INC CCOPTIO
-INC SMLMOTS
-INC SMCHPOI
-INC SMELEME
C
C**** La list des inconnues
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))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**** Le SPG
C
      CALL LIROBJ('MAILLAGE',IGEOM,1,IRET)
      IF(IERR .NE. 0) GOTO 9999
C
C**** On controle que le MELEME soit de type POI1
C     Si non changer
C
      MELEME = IGEOM
      SEGACT MELEME
      NBSOUS = MELEME.LISOUS(/1)
      NTYP = MELEME.ITYPEL
C
      IF ((NBSOUS.NE.0).OR.(NTYP.NE.1)) THEN
         CALL CHANGE(MELEME,1)
         IPT1 = IGEOM
         SEGDES IPT1
         IF (IERR.NE.0) GOTO 9999
      ENDIF
C
C**** Initialisation des MOT(1)
C
      MOT(1) = '    '
C
C**** Lecture du diametre minimum
C
      ICOND = 1
      CALL LIROBJ('CHPOINT',IDIAM,ICOND,IRET)
      IF (IERR.NE.0) GOTO 9999
C
C**** Control du CHPOINT: QUEPOI
C
      INDIC = 1
      NBCOMP = 1
      MOT(1) = 'SCAL'
      CALL QUEPOI(IDIAM, MELEME, INDIC, NBCOMP, MOT)
      IF(IERR .NE. 0)THEN
         IERR0 = IERR
 
C
C******** Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR = 'CHPO0 = ???                             '
         WRITE(IOIMP,*) MOTERR(1:40)
         IERR = IERR0
         GOTO 9999
      ENDIF
C
C**** Lecture du CHPOINT RO
C
      ICOND = 1
      CALL LIROBJ('CHPOINT',IRN,ICOND,IRET)
      IF (IERR.NE.0) GOTO 9999
C
C**** Control du CHPOINT: QUEPOI
C
C     On controlle que le chpoint est non-partitione
C
C     INDIC = 1   -> on impose le pointeur du support geometrique (MELEME)
C     INDIC = 0   -> on ne fait que verifier le support geometrique (MELEME)
C
C     NBCOMP > 0 -> numero des composantes
C
C     MOT(1) = ' ' obligatoire s'on connais pas les noms des composantes
C
      INDIC = 1
      NBCOMP = 1
      MOT(1) = 'SCAL'
      CALL QUEPOI(IRN, MELEME, INDIC, NBCOMP, MOT)
      IF(IERR .NE. 0)THEN
         IERR0 = IERR
         IERR = 0
C
C******** Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR = 'CHPO1 = ???                             '
         WRITE(IOIMP,*) MOTERR(1:40)
         IERR = IERR0
         GOTO 9999
      ENDIF
C
C**** Lecture du CHPOINT vitesse
C
      ICOND = 1
      CALL LIROBJ('CHPOINT',IVN,ICOND,IRET)
      IF (IERR.NE.0) GOTO 9999
C
C**** Control du CHPOINT
C
      INDIC = 1
      NBCOMP = IDIM
      JGN = 4
      JGM = IDIM
      SEGINI MLMOTS
      MLMOTS.MOTS(1) = 'UX  '
      MLMOTS.MOTS(2) = 'UY  '
      IF(IDIM .EQ. 3) MLMOTS.MOTS(3) = 'UZ  '
      CALL QUEPO1(IVN, MELEME, MLMOTS)
      IF(IERR .NE. 0)THEN
         IERR0 = IERR
         IERR = 0
C
C******** Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR  = 'CHPO2 = ???                             '
         WRITE(IOIMP,*) MOTERR(1:40)
 
         GOTO 9999
      ENDIF
      SEGSUP MLMOTS
C
C**** Lecture du CHPOINT PN
C
      ICOND = 1
      CALL LIROBJ('CHPOINT',IPN,ICOND,IRET)
      IF (IERR.NE.0) GOTO 9999
C
C**** Control du CHPOINT
C
      INDIC = 1
      NBCOMP = 1
      MOT(1) = 'SCAL'
      CALL QUEPOI(IPN, MELEME, INDIC, NBCOMP, MOT)
      IF(IERR .NE. 0)THEN
         IERR0 = IERR
 
C
C******** Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR  = 'CHPO3 = ???                             '
         WRITE(IOIMP,*) MOTERR(1:40)
 
         GOTO 9999
      ENDIF
C
C**** Lecture du CHPOINT GAMMA
C
      ICOND = 1
      CALL LIROBJ('CHPOINT',IGAMN,ICOND,IRET)
      IF(IERR .NE. 0)GOTO 9999
C
C**** Control du CHPOINT
C
      INDIC = 1
      NBCOMP = 1
      MOT(1) = 'SCAL'
      CALL QUEPOI(IGAMN, MELEME, INDIC, NBCOMP, MOT)
      IF(IERR .NE. 0)THEN
         IERR0 = IERR
 
C
C******* Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR  = 'CHPO4 = ???                             '
         WRITE(IOIMP,*) MOTERR(1:40)
 
         GOTO 9999
      ENDIF
C
C*** Reading IUPRI1
C
      ICOND = 1
      CALL LIROBJ('CHPOINT',IUPRI1,ICOND,IRET)
      IF(IERR .NE. 0)GOTO 9999
C
C**** Control du CHPOINT
C
      INDIC = 1
      NBCOMP = 1
      MOT(1) = 'SCAL'
      CALL QUEPOI(IUPRI1, MELEME, INDIC, NBCOMP, MOT)
      IF(IERR .NE. 0)THEN
         IERR0 = IERR
 
C
C******* Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR  = 'CHPO5 = ???                             '
         WRITE(IOIMP,*) MOTERR(1:40)
 
         GOTO 9999
      ENDIF
C
C*** Reading IUPRI2
C
      ICOND = 1
      CALL LIROBJ('CHPOINT',IUPRI2,ICOND,IRET)
      IF(IERR .NE. 0)GOTO 9999
C
C**** Control du CHPOINT
C
      INDIC = 1
      NBCOMP = 1
      MOT(1) = 'SCAL'
      CALL QUEPOI(IUPRI2, MELEME, INDIC, NBCOMP, MOT)
      IF(IERR .NE. 0)THEN
         IERR0 = IERR
 
C
C******* Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR  = 'CHPO6 = ???                             '
         WRITE(IOIMP,*) MOTERR(1:40)
 
         GOTO 9999
      ENDIF
C
C**** Calcul de la matrice \Gamma
C
      CALL KON171(MELEME,IDIAM,IRN,IVN,IPN,IGAMN,ILIINC,IUPRI1,IUPRI2,
     &     IGMAT)
      IF(IERR.NE.0) GOTO 9999
C
      TYPE='MATRIK '
      CALL ECROBJ(TYPE,IGMAT)
C
 9999 RETURN
      END