Sources Esope | Cast3M

pr1eca
C PR1ECA    SOURCE    CB215821  20/11/25    13:36:00     10792          
      SUBROUTINE PR1ECA(
     &            IM1,ICH1,ICH2,ICH3,ICH4,
     &            IVIT,IPRES,
     &            LOGNEG,LOGBOR,MESERR,
     &            VALER,VAL1,VAL2)
C************************************************************************
C
C PROJET            :  CASTEM 2000
C
C NOM               :  PR1ECA
C
C DESCRIPTION       :  VOIR PRIM1E
C
C                      Gaz ideal mono-espece:
C                      Calcul de vitesse, pression.
C
C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
C
C AUTEUR            :  A. BECCANTINI, DRN/DMT/SEMT/TTMF
C
C************************************************************************
C
C APPELES (E/S)     :  LICHT
C
C************************************************************************
C
C ENTREES  :
C
C            IM1     : MELEME contenant les centres des ELTs
C
C            ICH1    : CHPOINT  contenant la masse volumique.
C
C            ICH2    : CHPOINT contenant les dèbits
C                     ( NDIM  composantes);
C
C            ICH3    : CHPOINT  contenat l'énergie totale per
C                      unité de volume (RHO Et);
C
C            ICH4    : CHPOINT  contenant "gamma" du gaz.
C
C
C SORTIES  : IVIT    : CHPOINT  contenant les "gamma" du gaz;
C
C            IPRES   : CHPOINT  contenant la pression du gaz;
C
C            LOGNEG  : (LOGICAL): si .TRUE. une pression ou une densité
C                      negative a été detectée -> le programme s'arrete
C                      (sa valeur stockée en MESERR(1) et VALER(1))
C
C            LOGBOR  : (LOGICAL)
C                      gamma a été detecté dehor GAMMIN et GAMMAX
C                      (sa valeur stockée en MESERR(2) et  VALER(2),VAL1,VAL2)
C
C            MESERR,
C            VALER,
C            VAL1,
C            VAL2    : pour message d'erreur
C
C
C************************************************************************
C
C HISTORIQUE (Anomalies et modifications éventuelles)
C
C HISTORIQUE :  Créée le 12.1.98.
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
C
C**** Les variables
C
      IMPLICIT INTEGER(I-N)
      INTEGER
     &        IM1,ICH1,ICH2,ICH3,ICH4
     &       ,IVIT,IPRES
     &       ,NLCE, N1, IGEOMC
      REAL*8  VALER(2),VAL1,VAL2
     &        ,RO,UX,UY,UZ,P
     &        ,ROET, ROETH, CELL
     &        ,GAMMIN,GAMMAX,GAMMA
      PARAMETER(GAMMIN=1.0D0,GAMMAX=3.0D0)
C
      CHARACTER*(8) TYPE
      CHARACTER*(40) MESERR(2)
      LOGICAL LOGNEG, LOGBOR
C
C
C**** Les includes
C
 
-INC PPARAM
-INC CCOPTIO
-INC SMCHPOI
-INC SMELEME
C
C
C**** Initialisation des variables pour la gestion des erreurs pas ici,
C     mais avant, i.e.
C
C      LOGNEG  = .FALSE.
C      LOGBOR  = .FALSE.
C      MESERR(1)  = '                                        '
C      MESERR(2)  = '                                        '
C
C**** Activation du MELEME "CENTRE"
C
      IPT1 = IM1
      SEGACT IPT1
      N1 = IPT1.NUM(/2)
C
C**** Creation des CHPOINTs IVIT, IPRES
C
C     ITEMP CHPOINT simile aux ICH1
C     Donc on lit ICH1
C
      MCHPO1 = ICH1
      SEGACT MCHPO1
      MSOUP1 = MCHPO1.IPCHP(1)
      SEGACT MSOUP1
      MPOVA1 = MSOUP1.IPOVAL
      SEGACT MPOVA1
C
C***  MPOVA6 = IPOVAL de IPRES
C
      SEGINI, MPOVA6 = MPOVA1
      SEGINI, MSOUP2 = MSOUP1
      MSOUP2.IPOVAL = MPOVA6
      SEGINI, MCHPO2 = MCHPO1
      MCHPO2.IPCHP(1)= MSOUP2
      IPRES = MCHPO2
C
C***  IVIT simil au CHPOINT ICH2 (DEBITs).
C
      MCHPO1 = ICH2
      SEGACT MCHPO1
      MSOUP1 = MCHPO1.IPCHP(1)
      SEGACT MSOUP1
      MPOVA2 = MSOUP1.IPOVAL
      SEGACT MPOVA2
C
C**** IVIT
C
      SEGINI, MPOVA5 = MPOVA2
      SEGINI, MSOUP2 = MSOUP1
      MSOUP2.IPOVAL = MPOVA5
      SEGINI, MCHPO2 = MCHPO1
      MCHPO2.IPCHP(1)= MSOUP2
      IVIT = MCHPO2
C
C**** Lecture de MPOVALs  des autres MCHPOIs
C
      CALL LICHT(ICH3,MPOVA3,TYPE,IGEOMC)
      CALL LICHT(ICH4,MPOVA4,TYPE,IGEOMC)
C
C**** LICHT active les MPOVALs en *MOD
C
C     i.e.
C
C     SEGACT MPOVA3*MOD
C     SEGACT MPOVA4*MOD
C
C
C**** RICAPITOLATIF
C
C     On a activé que les MPOVA1 - MPOVA7
C
C     MPOVA1 = RO
C     MPOVA2 = DEBIT
C     MPOVA3 = ROET
C     MPOVA4 = GAMMA
C     MPOVA5 = VITESSE
C     MPOVA6 = PRES
C
C**** BOUCLE SUR LES CENTRES pour le calcul du FLUX.
C
      DO NLCE = 1, N1
C
C******* Les differents variables a chaque centre
C
         RO   = MPOVA1.VPOCHA(NLCE,1)
         IF(RO .LE. 0.0D0)THEN
            VALER(1) = RO
            MESERR(1) = 'RO                                      '
            LOGNEG = .TRUE.
C
C********** RO &lt; 0: le programme s'arrete mais apres le calcul des
C                   CHPOINTs
C
         ENDIF
         UX = MPOVA2.VPOCHA(NLCE,1)/RO
         UY = MPOVA2.VPOCHA(NLCE,2)/RO
         MPOVA5.VPOCHA(NLCE,1)=UX
         MPOVA5.VPOCHA(NLCE,2)=UY
         IF(IDIM .EQ. 3) THEN
            UZ = MPOVA2.VPOCHA(NLCE,3)/RO
            MPOVA5.VPOCHA(NLCE,3)=UZ
         ENDIF
         ROET = MPOVA3.VPOCHA(NLCE,1)
         CELL = UX*UX + UY*UY
         IF(IDIM .EQ. 3) CELL = CELL +UZ*UZ
         CELL = 0.5D0 * CELL *RO
         ROETH = ROET - CELL
         GAMMA = MPOVA4.VPOCHA(NLCE,1)
         IF((GAMMA .LT. GAMMIN) .OR. (GAMMA .GT. GAMMAX))THEN
            MESERR(2) = 'GAMMA                                   '
            VALER(2)  = GAMMA
            VAL1 = GAMMIN
            VAL2 = GAMMAX
            LOGBOR = .TRUE.
C
C********** GAMMA !\in (GAMMIN,GAMMAX) : le programme s'arrete
C           mais apres le calcul des  CHPOINTs
C
         ENDIF
         P = (GAMMA - 1.0D0) * ROETH
         IF(P .LE. 0.0D0)THEN
            VALER(1) = P
            MESERR(1) = 'P                                       '
            LOGNEG = .TRUE.
C
C********** P &lt; 0: le programme s'arrete mais apres le calcul des
C                   CHPOINTs
C
         ENDIF
         MPOVA6.VPOCHA(NLCE,1) = P
      ENDDO
      END