Sources Esope | Cast3M

prim1e
C PRIM1E    SOURCE    OF166741  24/12/13    21:17:14     12097          
      SUBROUTINE PRIM1E()
C************************************************************************
C
C PROJET            :  CASTEM 2000
C
C NOM               :  PRIM1E (OPERATEUR GIBIANE)
C
C DESCRIPTION       :  Voir PRIMIT
C
C                      Calcul des variables primitives (et du "gamma")
C                      pour les gas "calorically perfect" monoespeces
C
C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
C
C AUTEUR            :  A. BECCANTINI, DRN/DMT/SEMT/TTMF
C
C************************************************************************
C
C
C APPELES (E/S)     : LIROBJ, QUEPOI, QUEPO1, ERREUR, ECROBJ, LIRCHA,
C                     ECRCHA
C
C APPELES (Calcul)  : PR1ECA
C
C
C************************************************************************
C
C PHRASE D'APPEL (GIBIANE) :
C
C 1) gaz ideal mono-espece
C
C  RCHPO1 RCHPO2 =  'PRIM' MCLE1  CHPO1 CHPO2 CHPO3 CHPO4 (MCLE2) ;
C
C
C ENTREES  :
C
C            MCLE1   : mot clé, 'PERFMONO'
C
C            CHPO1   : CHPOINT  contenant la masse volumique
C                      (une composante, 'SCAL').
C
C            CHPO2   : CHPOINT  contenant les dèbits
C                     (2 composantes en 2D, 'UX  ','UY  ');
C
C            CHPO3   : CHPOINT  contenat l'énergie totale per
C                      unité de volume (RHO Et),
C                      (une composante, 'SCAL').
C
C            i.e.    CHPO1, CHPO2, CHPO3  sont les variables
C                          conservatives des Equations d'Euler.
C
C            CHPO4   : CHPOINT  contenat les "gamma" du gaz
C                      (une composante, 'SCAL').
C
C            MCLE2   : Option personelle: pas dans la notice
C                      officielle!!!
C                      Mot clé, 'TRICHE' (s'il y a un erreur,
C                      les objects RCHPO1 et RCHPO2 ne sont pas
C                      des type ANNULLE et le programme
C                      ne s'arrete pas!!!)
C
C SORTIES  :
C
C            RCHPO1  : CHPOINT  contenant la vitesse
C
C            RCHPO2  : CHPOINT  contenant la pression du gaz;
C
C************************************************************************
C
C HISTORIQUE (Anomalies et modifications éventuelles)
C
C HISTORIQUE :  Créée le 12.1.98.
C
C               Modifie le 30.7.98 pour ajouter le mot clee personelle
C               'TRICHE'
C
C               Modifie le 28.09.00 pour control sur le noms de composantes
C               (subroutine  QUEPO1)
C               Variables de CCOPTIO en commentaire
C               Elimination de ERREUR(-301)
C
C************************************************************************
C
C**** Les variables
C
      IMPLICIT INTEGER(I-N)
      INTEGER ICOND, IRETOU, INDIC, NBCOMP, IERR0
     &       , ICEN, IRO, IROVIT, IROET, IGAMMA
     &       , IPRES, IVIT, JGN, JGM
      REAL*8 VALER(2),VAL1,VAL2
      CHARACTER*(40) MESERR(2),MESCEL
      CHARACTER*(4)  MOT(1)
      CHARACTER*(6) NOMTRI
      LOGICAL LOGNEG, LOGBOR, LOGTRI
C
C**** Les Includes
C
 
-INC PPARAM
-INC CCOPTIO
-INC SMCHPOI
-INC SMLMOTS
C
C**** Initialisation des parametres d'erreur
C
      LOGNEG  = .FALSE.
      LOGBOR  = .FALSE.
      MESCEL = '                                        '
      MESERR(1) = MESCEL
      MESERR(2) = MESCEL
      MOTERR(1:40) = MESCEL
      VALER(1) = 0.0D0
      VALER(2) = 0.0D0
      VAL1 = 0.0D0
      VAL2 = 0.0D0
C
C**** Initialisation des MOT(1)
C
      MOT(1) = '    '
C
C**** Lecture du CHPOINT RO
C
      ICOND = 1
      CALL LIROBJ('CHPOINT ',IRO,ICOND,IRETOU)
      CALL ACTOBJ('CHPOINT ',IRO,1)
      IF (IERR.NE.0) GOTO 9999
C
C**** On cherche le pointeur de son maillage et on l'impose sur les
C     autres CHPOINT
C
      MCHPOI = IRO
      SEGACT MCHPOI
      MSOUPO = MCHPOI.IPCHP(1)
      SEGACT MSOUPO
      ICEN = MSOUPO.IGEOC
      SEGDES MSOUPO
      SEGDES MCHPOI
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 (ICEN)
C     INDIC = 0   -> on ne fait que verifier le support geometrique (ICEN)
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(IRO, ICEN, INDIC, NBCOMP, MOT)
      IF(IERR .NE. 0)THEN
         IERR0 = IERR
 
C
C******** Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR = 'CHPO1 = ???                             '
         WRITE(IOIMP,*) MOTERR(1:40)
 
         GOTO 9999
      ENDIF
C
C**** Lecture du CHPOINT DEBIT.
C
      ICOND = 1
      CALL LIROBJ('CHPOINT',IROVIT,ICOND,IRETOU)
      CALL ACTOBJ('CHPOINT',IROVIT,1)
      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(IROVIT, ICEN, MLMOTS)
      IF(IERR .NE. 0)THEN
         IERR0 = IERR
 
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 ROET
C
      ICOND = 1
      CALL LIROBJ('CHPOINT',IROET,ICOND,IRETOU)
      CALL ACTOBJ('CHPOINT',IROET,1)
      IF (IERR.NE.0) GOTO 9999
C
C**** Control du CHPOINT
C
      INDIC = 1
      NBCOMP = 1
      MOT(1) = 'SCAL'
      CALL QUEPOI(IROET, ICEN, 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',IGAMMA,ICOND,IRETOU)
      CALL ACTOBJ('CHPOINT',IGAMMA,1)
      IF(IERR .NE. 0)GOTO 9999
C
C**** Control du CHPOINT
C
      INDIC = 1
      NBCOMP = 1
      MOT(1) = 'SCAL'
      CALL QUEPOI(IGAMMA, ICEN, 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******* Option TRICHE
C
      ICOND = 0
      CALL LIRCHA(NOMTRI,ICOND,IRETOU)
      IF(IERR .NE. 0)GOTO 9999
      IF(IRETOU .EQ. 0)THEN
         LOGTRI = .FALSE.
      ELSEIF(NOMTRI .EQ. 'TRICHE')THEN
         LOGTRI  = .TRUE.
      ELSE
         LOGTRI = .FALSE.
         CALL ECRCHA(NOMTRI)
      ENDIF
C
C**** Calcul des sorties.
C
      CALL PR1ECA(
     &            ICEN,IRO,IROVIT,IROET,IGAMMA,
     &            IVIT,IPRES,
     &            LOGNEG,LOGBOR,MESERR,
     &            VALER,VAL1,VAL2)
C
      IERR0 = 0
      IF(LOGNEG)THEN
C
C******* Pression (energie thermique)  ou densité negative
C
C
C******* Message d'erreur standard
C        41 2
C        %m1:8 = %r1 inférieur à %r2
C
         MESCEL = MESERR(1)
         MOTERR(1:8) = MESCEL(1:8)
         REAERR(1) = REAL(VALER(1))
         REAERR(2) = 0.0
         CALL ERREUR(41)
         IF(LOGTRI)THEN
*            IERR = 0
         ELSE
            GOTO 9999
         ENDIF
      ENDIF
      IF(LOGBOR)THEN
C
C******* GAMMA dehor GAMMIN, GAMMAX
C
C******* Message d'erreur standard
C        42 2
C        %m1:8 = %r1 non compris entre %r2 et %r3
C
         MESCEL = MESERR(2)
         MOTERR(1:8) = MESCEL(1:8)
         REAERR(1) = REAL(VALER(2))
         REAERR(2) = REAL(VAL1)
         REAERR(3) = REAL(VAL2)
         CALL ERREUR(42)
         IF(LOGTRI)THEN
*            IERR = 0
         ELSE
            GOTO 9999
         ENDIF
      ENDIF
 
C**** Ecriture du CHPOINT contenant la pression.
      CALL ACTOBJ('CHPOINT ',IPRES,1)
      CALL ECROBJ('CHPOINT ',IPRES)
 
C**** Ecriture du CHPOINT contenant la vitesse.
      CALL ACTOBJ('CHPOINT ',IVIT,1)
      CALL ECROBJ('CHPOINT ',IVIT)
 
C
 9999 CONTINUE
      END