Sources Esope | Cast3M

kon14
C KON14     SOURCE    CB215821  20/11/25    13:31:51     10792          
      SUBROUTINE KON14
C************************************************************************
C
C PROJET            :  CASTEM 2000
C
C NOM               :  KON14
C
C DESCRIPTION       :  Subroutine appellée par KON1
C
C                      Modelisation 2D/3D des equations d'Euler
C                      Calcul du jacobien par rapport aux
C                      variables primitives
C
C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
C
C AUTEUR            :  A. BECCANTINI, DRN/DMT/SEMT/LTMF
C
C************************************************************************
C
C APPELES (Calcul)  :  KONJP1 (calcul du jacobien, gaz "calorically
C                              perfect", monoespece, 2D, VLH)
C                      KONJP2 (calcul du jacobien, gaz "calorically
C                              perfect", monoespece, 2D, AUSMplus)
C                      KONJP3 (calcul du jacobien, gaz "calorically
C                              perfect", monoespece, 3D, VLH)
C                      KONJP4 (calcul du jacobien, gaz "calorically
C                              perfect", monoespece, 3D, AUSMplus)
C                      KONJP5 (calcul du jacobien, gaz "calorically
C                              perfect", monoespece, 2D
C                              AUSMPLM)
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' 'JACOPRIM' MOD1 LMOT1 LMOT2
C          (MAILIM) MOT3 CHPO1 CHPO2 CHPO3 CHPO4 ;
C
C  or (Bas MAch)
C
C  RMAT1 = 'KONV' 'VF' 'PERFMONO' 'JACOPRIM' MOD1 LMOT1 LMOT2
C          (MAILIM) MOT3 CHPO1 CHPO2 CHPO3 CHPO4
C          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  MOD1   : objet modele de type Navier_Stokes
C
C  MOT3   : objet de type MOT
C           'VLH'  : jacobien du residu pour la methode VLH
C           'AUSMPLUUS' : jacobien du residu pour la methode AUSM+
C           'AUSMPLM'   : jacobien du residu pour la methode AUSM+ low
C                         Mach
C
C (MAILIM): MAIILAGE de POI1 ou on ne veut pas calculer le FLUX convective
C
C  CHPO1  : CHPOINT contenant la masse volumique
C           (SPG =('DOMA' MOD1 'CENTRE'), une seule composante,
C           'SCAL').
C
C  CHPO2  : CHPOINT contenant la vitesse
C           (SPG =('DOMA' MOD1 'CENTRE'), deux/trois composantes
C           'UX', 'UY', 'UZ')
C
C  CHPO3  : CHPOINT contenant la pression du gaz
C           (SPG =('DOMA' MOD1 'CENTRE'), une seule composante,
C            'SCAL').
C
C  CHPO4  : CHPOINT contenant le "gamma" du gaz
C           (SPG =('DOMA' MOD1 'CENTRE'), une seule composante,
C            'SCAL').
C
C  CHPO5  : CHPOINT contenant la premiere vitesse de cut-off
C           (SPG =('DOMA' MOD1 'CENTRE'), une seule composante,
C            'SCAL').
C
C  CHP06  : CHPOINT contenant la deuxieme vitesse de cut-off
C           (SPG =('DOMA' MOD1 'CENTRE'), une seule composante,
C            'SCAL').
C
C SORTIES
C
C  RMAT1  : objet de type MATRIK
C          (SPG =('DOMA' MOD1 'CENTRE'))
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 NBJAC, IRET, INDIC, NBCOMP, NESP, JGN, JGM
     &     ,IDOMA, MELEMC, MELEMF, MELEFE, MELTFA, ICHPSU, ICHPDI
     &     ,ICHPVO, INORM, INEFMD, ICOND
     &     ,IJACO, ILIINC, ILIINP, NC, IFLIM, MELLIM, ICACCA
     &     ,IIMPL, IRN, IVN, IPN, IGAMN, IUINF, IUPRI
C
      PARAMETER (NBJAC=3)
      CHARACTER*8 TYPE, LJACO(NBJAC)
      CHARACTER*4 MOT
      CHARACTER*(40) MESERR
      DATA LJACO/'VLH     ','AUSMPLUS','AUSMPLM '/
C
C**********************************
C**** Lecture de l'objet MODELE ***
C**********************************
C
      ICOND = 1
      CALL QUETYP(TYPE,ICOND,IRET)
 
      IF(IRET.EQ.0.AND.TYPE.NE.'MMODEL')THEN
        WRITE(6,*)' On attend un objet MMODEL'
        RETURN
      ENDIF
      CALL LIROBJ('MMODEL',MMODEL,ICOND,IRET)
      IF(IERR.NE.0)GOTO 9999
      CALL LEKMOD(MMODEL,IDOMA,INEFMD)
      IF(IERR.NE.0)GOTO 9999
C
C**** Centre, FACE, FACEL, ELTFA
C
      CALL LEKTAB(IDOMA,'CENTRE',MELEMC)
      IF(IERR .NE. 0) GOTO 9999
C
      CALL LEKTAB(IDOMA,'FACE',MELEMF)
      IF(IERR .NE. 0) GOTO 9999
C
      CALL LEKTAB(IDOMA,'FACEL',MELEFE)
      IF(IERR .NE. 0) GOTO 9999
C
      CALL LEKTAB(IDOMA,'ELTFA',MELTFA)
      IF(IERR .NE. 0) GOTO 9999
C
C**** Lecture du CHPOINT contenant les surfaces des faces.
C
      CALL LEKTAB(IDOMA,'XXSURFAC',ICHPSU)
      IF(IERR .NE. 0) GOTO 9999
      INDIC = 1
      NBCOMP = 1
      MOT = 'SCAL'
      CALL QUEPOI(ICHPSU, MELEMF, INDIC, NBCOMP, MOT)
      IF(IERR .NE. 0) GOTO 9999
C
C**** Lecture du CHPOINT contenant les diametres minimums.
C
      CALL LEKTAB(IDOMA,'XXDIEMIN',ICHPDI)
      IF(IERR .NE. 0) GOTO 9999
      INDIC = 1
      NBCOMP = 1
      MOT = 'SCAL'
      CALL QUEPOI(ICHPDI, MELEMC, INDIC, NBCOMP, MOT)
      IF(IERR .NE. 0) GOTO 9999
C
C**** Lecture du CHPOINT contenant les volumes
C
      CALL LEKTAB(IDOMA,'XXVOLUM',ICHPVO)
      IF(IERR .NE. 0) GOTO 9999
      INDIC = 1
      NBCOMP = 1
      MOT = 'SCAL'
      CALL QUEPOI(ICHPVO, MELEMC, INDIC, NBCOMP, MOT)
      IF(IERR .NE. 0) GOTO 9999
C
C**** Les normales aux faces
C
      IF(IDIM .EQ. 2)THEN
C        Que les normales
         CALL LEKTAB(IDOMA,'XXNORMAF',INORM)
         IF(IERR .NE. 0) GOTO 9999
         JGN = 4
         JGM = 2
         SEGINI MLMVIT
         MLMVIT.MOTS(1) = 'UX  '
         MLMVIT.MOTS(2) = 'UY  '
         CALL QUEPO1(INORM, MELEMF, MLMVIT)
         SEGSUP MLMVIT
         IF(IERR .NE. 0) GOTO 9999
      ELSE
C        Les normales et les tangentes
         TYPE = ' '
         CALL ACMO(IDOMA,'MATROT',TYPE,INORM)
         IF (TYPE .NE. 'CHPOINT ') THEN
            CALL MATRAN(IDOMA,INORM)
            IF(IERR .NE. 0) GOTO 9999
         ENDIF
         JGN = 4
         JGM = 9
         SEGINI MLMVIT
         MLMVIT.MOTS(1) = 'UX  '
         MLMVIT.MOTS(2) = 'UY  '
         MLMVIT.MOTS(3) = 'UZ  '
         MLMVIT.MOTS(4) = 'RX  '
         MLMVIT.MOTS(5) = 'RY  '
         MLMVIT.MOTS(6) = 'RZ  '
         MLMVIT.MOTS(7) = 'MX  '
         MLMVIT.MOTS(8) = 'MY  '
         MLMVIT.MOTS(9) = 'MZ  '
         CALL QUEPO1(INORM, MELEMF, MLMVIT)
         SEGSUP MLMVIT
      ENDIF
C
C********************************
C**** Fin table domaine *********
C********************************
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**** Boundary condition
C
      IRET=0
      TYPE='MAILLAGE'
      CALL LIROBJ(TYPE,IFLIM,0,IRET)
      IF(IERR.NE.0)GOTO 9999
      IF(IRET .EQ. 0)THEN
         MELLIM = 0
      ELSE
         MELEME=IFLIM
         SEGACT MELEME
         ICACCA=MELEME.NUM(/2)
         IF(ICACCA .EQ. 0)THEN
            MELLIM = 0
         ELSE
            MELLIM = IFLIM
         ENDIF
         SEGDES MELEME
      ENDIF
C
C**** Type of Jacobian
C
      CALL LIRMOT(LJACO,NBJAC,IIMPL,1)
      IF(IERR .NE. 0)GOTO 9999
 
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**** Bas Mach
C
      IF(IIMPL .EQ. 3)THEN
         TYPE = 'CHPOINT '
C
C******* Cut off 1
C
         CALL LIROBJ(TYPE,IUINF,1,IRET)
         IF(IERR .NE. 0) GOTO 9999
         INDIC = 1
         NBCOMP = 1
         MOT = 'SCAL'
         CALL QUEPOI(IUINF, MELEMC, INDIC, NBCOMP, MOT)
         IF(IERR .NE. 0) GOTO 9999
C
C******* Cut off 2
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
      ELSE
         IUINF=0
         IUPRI=0
      ENDIF
C
C******* Calcul du jacobien
C
      IF(IIMPL .EQ. 1)THEN
C
C********** VLH
C
         IF(IDIM .EQ. 2)THEN
            CALL KONJP1(ILIINC,ILIINP,IRN,IVN,IPN,IGAMN,INORM
     $           ,ICHPVO,ICHPSU, MELEMC, MELEFE, MELLIM, IJACO)
            IF(IERR .NE. 0) GOTO 9999
         ELSE
            CALL KONJP3(ILIINC,ILIINP,IRN,IVN,IPN,IGAMN,INORM
     $           ,ICHPVO,ICHPSU, MELEMC, MELEFE, MELLIM, IJACO)
            IF(IERR .NE. 0) GOTO 9999
         ENDIF
      ELSEIF(IIMPL .EQ. 2)THEN
C
C********** AUSM+
C
         IF(IDIM .EQ. 2)THEN
            CALL KONJP2(ILIINC,ILIINP,IRN,IVN,IPN,IGAMN,INORM
     $           ,ICHPVO,ICHPSU, MELEMC, MELEFE, MELLIM, IJACO)
            IF(IERR .NE. 0) GOTO 9999
         ELSE
            CALL KONJP4(ILIINC,ILIINP,IRN,IVN,IPN,IGAMN,INORM
     $           ,ICHPVO,ICHPSU, MELEMC, MELEFE, MELLIM, IJACO)
            IF(IERR .NE. 0) GOTO 9999
         ENDIF
      ELSEIF(IIMPL .EQ. 3)THEN
C
C********** AUSM+LM
C
         IF(IDIM .EQ. 2)THEN
            CALL KONJP5(ILIINC,ILIINP,IRN,IVN,IPN,IGAMN,INORM,
     $           ICHPVO,ICHPSU, IUINF, IUPRI, MELEMC, MELEFE,
     $           MELLIM, IJACO)
            IF(IERR .NE. 0) GOTO 9999
         ELSE
            CALL ERREUR(251)
         ENDIF
      ELSE
C        Tentative d'utilisation d'une option non implémentée
         CALL ERREUR(251)
         GOTO 9999
      ENDIF
C
C**** Ecriture des resultats
C
      TYPE='MATRIK '
      CALL ECROBJ(TYPE,IJACO)
 9999 CONTINUE
      RETURN
      END