Télécharger prmeca.eso

Retour à la liste

prmeca
C PRMECA    SOURCE    CB215821  20/11/25    13:37:10     10792          
      SUBROUTINE PRMECA(NESP,
     &            ICEN,IRO,IROVIT,IROET,IROY,MLRECP,MLRECV,
     &            IVIT,IPRES,ITEMP,IY,IGAM,
     &            LOGAN,LOGNEG,LOGBOR,MESERR,
     &            VALER, VAL1,VAL2)
C
C************************************************************************
C
C PROJET            :  CASTEM 2000
C
C NOM               :  PRMECA
C
C DESCRIPTION       :  VOIR PRIMME
C
C                      Melange des gaz "calorically perfect".
C
C                      Calcul de la vitesse, de la pression, de la
C                      temperature, des fractions massiques, de "gamma"
C
C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
C
C AUTEUR            :  A. BECCANTINI, DRN/DMT/SEMT/TTMF
C
C************************************************************************
C
C APPELES           : LICHT, ACCTAB
C
C************************************************************************
C
C ENTREES  : NESP    : nombre d'especes dans le melange.
C
C            ICEN    : MELEME contenant les centres des ELTs
C
C            IRO     : CHPOINT  contenant la masse volumique.
C
C            IROVIT  : CHPOINT contenant les dèbits
C                     ( NDIM  composantes);
C
C            IROET   : CHPOINT  contenat l'énergie totale per
C                      unité de volume (RHO Et);
C
C            IROY    : CHPOINT  contenant la masse de
C                      differentes especes;
C
C            MLRECP  : LREEL contenant les CP des differentes especes
C
C            MLRECV  : LREEL contenant les CV des differentes especes
C
C SORTIES  :
C
C            IVIT    : CHPOINT  contenant la vitesse
C
C            IPRES   : CHPOINT  contenant la pression du gaz;
C
C            ITEMP   : CHPOINT  contenant la temperature du
C                      gaz;
C
C            IY      : CHPOINT  contenant les fractions
C                      massiques du gaz;
C
C            IGAM    : CHPOINT  contenant les "gamma" du gaz;
C
C            LOGAN   : anomalie detectée
C
C            LOGNEG  : (LOGICAL): si .TRUE. une pression ou une densité
C                      negative a été detectée -> le programme s'arrete
C                      et on peut visualiser le champe de pression et de
C                      volume (sa valeur stockée en MESERR(1) et
C                      VALER(1))
C
C            LOGBOR  : (LOGICAL)
C                      si .TRUE. la fraction massique a ete
C                      detecté  dehor YMIN et YMAX
C                      (sa valeur stockée en MESERR(2) et  VALER(2)
C                      ,VAL1,VAL2)
C                      ou
C                      la pression a été detectée  dehor PMIN et PMAX
C                      (sa valeur stockée en MESERR(2) et
C                      VALER(2),VAL1,VAL2)
C
C                      ou
C                      gamma a été detecté dehor GAMMIN et GAMMAX
C                      (sa valeur stockée en MESERR(2) et
C                      VALER(2),VAL1,VAL2)
C
C
C            MESERR(2),
C            VALER(2),
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 NESP
     &       ,ICEN,IRO,IROVIT,IROET,IROY
     &       ,IVIT,IPRES,IY,IGAM,IGEOMC
     &       ,N1,NLCE,I1,ITEMP
C
C**** NESP = Nombre d'especes dans le gaz.
C
      REAL*8   EPSI,VALER(2),VAL1,VAL2
     &        ,YMIN,YMAX
     &        ,RO,UX,UY,UZ,RETOT,RETHER,CELL
     &        ,CPTOT,CVTOT,CP,CV
     &        ,GAMMA,GAMMIN,GAMMAX
     &        ,P, T
      CHARACTER*(8) TYPE
      CHARACTER*(40) MESERR(2)
      LOGICAL LOGNEG, LOGBOR, LOGAN
C
C**** Valeur minimum di Y et T(°C)
C
C     N.B.: il doit etre le meme dans gamma.eso.
C
      PARAMETER(EPSI=1.0D-4,
     &          YMIN=-EPSI,YMAX=1.0D0+EPSI,
     &          GAMMIN=1.0D0,GAMMAX=3.0D0)
C
C**** Les includes
C
-INC PPARAM
-INC CCOPTIO
-INC SMCHPOI
      POINTEUR MPORO.MPOVAL,  MPOROV.MPOVAL, MPOROE.MPOVAL,
     &         MPOROY.MPOVAL, MPOVIT.MPOVAL, MPOTEM.MPOVAL,
     &         MPOPRE.MPOVAL, MPOY.MPOVAL,   MPOGAM.MPOVAL,
     &         MSOUPY.MSOUPO
-INC SMELEME
-INC SMLREEL
      POINTEUR MLRECP.MLREEL, MLRECV.MLREEL
C
C**** Y(NESP)
C
      SEGMENT FRAMAS
         REAL*8 Y(NESP)
      ENDSEGMENT
      SEGINI FRAMAS
C
C**** Initialisation des variables pour la gestion des erreurs pas ici,
C     mais avant, i.e.
C
C      LOGAN   = .FALSE.
C      LOGNEG  = .FALSE.
C      LOGBOR  = .FALSE.
C      MESERR(1)  = '                                        '
C      MESERR(2)  = '                                        '
C
C
C**** Activation du MELEME "CENTRE"
C
      IPT1 = ICEN
      SEGACT IPT1
      N1 = IPT1.NUM(/2)
      SEGDES IPT1
C
C***  IVIT ressemble CHPOINT IROVIT (DEBIT).
C
      MCHPO1 = IROVIT
      SEGACT MCHPO1
      MSOUP1 = MCHPO1.IPCHP(1)
      SEGDES MCHPO1
      SEGACT MSOUP1
      MPOROV = MSOUP1.IPOVAL
      SEGDES MSOUP1
      SEGACT MPOROV
C
C**** IVIT
C
      SEGINI, MPOVIT = MPOROV
      SEGINI, MSOUP2 = MSOUP1
      MSOUP2.IPOVAL = MPOVIT
      SEGINI, MCHPO2 = MCHPO1
      MCHPO2.IPCHP(1)= MSOUP2
      SEGDES MSOUP2
      SEGDES MCHPO2
      IVIT = MCHPO2
C
C**** Creation des CHPOINTs IPRES et IGAM
C
C     Ce CHPOINT ressemble à IRO
C     Donc on lit IRO
C
      MCHPO1 = IRO
      SEGACT MCHPO1
      MSOUP1 = MCHPO1.IPCHP(1)
      SEGDES MCHPO1
      SEGACT MSOUP1
      MPORO = MSOUP1.IPOVAL
      SEGDES MSOUP1
      SEGACT MPORO
C
C***  IPRES
C
      SEGINI, MPOPRE = MPORO
      SEGINI, MSOUP2 = MSOUP1
      MSOUP2.IPOVAL = MPOPRE
      SEGINI, MCHPO2 = MCHPO1
      MCHPO2.IPCHP(1)= MSOUP2
      SEGDES MSOUP2
      SEGDES MCHPO2
      IPRES = MCHPO2
C
C***  ITEMP
C
      SEGINI, MPOTEM = MPORO
      SEGINI, MSOUP2 = MSOUP1
      MSOUP2.IPOVAL = MPOTEM
      SEGINI, MCHPO2 = MCHPO1
      MCHPO2.IPCHP(1)= MSOUP2
      SEGDES MSOUP2
      SEGDES MCHPO2
      ITEMP = MCHPO2
C
C***  IGAM
C
      SEGINI, MPOGAM = MPORO
      SEGINI, MSOUP2 = MSOUP1
      MSOUP2.IPOVAL = MPOGAM
      SEGINI, MCHPO2 = MCHPO1
      MCHPO2.IPCHP(1)= MSOUP2
      SEGDES MSOUP2
      SEGDES MCHPO2
      IGAM = MCHPO2
C
C***  IY
C
C     Ce CHPOINT ressemble à IROY
C     Donc on lit IROY
C
      MCHPO1 = IROY
      SEGACT MCHPO1
      MSOUPY = MCHPO1.IPCHP(1)
      SEGDES MCHPO1
      SEGACT MSOUPY
      MPOROY = MSOUPY.IPOVAL
      SEGACT MPOROY
C
      SEGINI, MPOY = MPOROY
      SEGINI, MSOUP2 = MSOUPY
      MSOUP2.IPOVAL = MPOY
      SEGINI, MCHPO2 = MCHPO1
      MCHPO2.IPCHP(1)= MSOUP2
      SEGDES MSOUP2
      SEGDES MCHPO2
      IY = MCHPO2
C
C**** Lecture des MPOVALs  des autres MCHPOIs
C
      CALL LICHT(IROET,MPOROE,TYPE,IGEOMC)
C
C**** LICHT active les MPOVALs en *MOD
C
C     i.e.
C
C     SEGACT MPOROE*MOD
C
C
C**** RICAPITOLATIF
C
C     On a activé que les CHPOINTs suivants
C
C     MPORO  < -- > RO
C     MPOROV < -- > DEBITS
C     MPOROE < -- > ROET
C     MPOROY < -- > ROY
C     MPOVIT < -- > IVIT
C     MPOPRE < -- > IPRES
C     MPOTEM < -- > ITEM
C     MPOY   < -- > IY
C     MPOGAM < -- > IGAM
C
C     En plus MSOUPY, le MSOUPO du IROY est activée
C
C
C**** BOUCLE SUR LES CENTRES pour le calcul des MPOVAL
C
      DO NLCE = 1, N1
C
C******* Les differents variables a chaque centre
C
         RO   = MPORO.VPOCHA(NLCE,1)
         IF(RO .LE. 0.0D0)THEN
            VALER(1) = RO
            MESERR(1) = 'RO                                      '
            LOGNEG = .TRUE.
C
C********** RO < 0: le programme s'arrete mais apres le calcul des
C                   CHPOINTs
C
         ENDIF
         UX = MPOROV.VPOCHA(NLCE,1)/RO
         UY = MPOROV.VPOCHA(NLCE,2)/RO
C
C******* VITESSE  ->  MPOVIT
C
         MPOVIT.VPOCHA(NLCE,1) = UX
         MPOVIT.VPOCHA(NLCE,2) = UY
         CELL = UX * UX + UY * UY
         IF(IDIM .EQ. 3)THEN
            UZ = MPOROV.VPOCHA(NLCE,3)/RO
            MPOVIT.VPOCHA(NLCE,3) = UZ
            CELL = CELL + UZ * UZ
         ENDIF
         CELL = 0.5D0 * RO * CELL
C
C******* RETOT, RETHER
C
         RETOT = MPOROE.VPOCHA(NLCE,1)
         RETHER = RETOT - CELL
C
C******* Y -> MPOY.
C
C        Calcul de GAMMA
C
C        IGAM -> MPOGAM
C
C        On a utilisé le ponteur par defaut,
C        i.e. Y(I1) = FRAMAS.Y(I1)
C
         Y(NESP) = 1.0D0
         CPTOT = 0.0D0
         CVTOT = 0.0D0
C
C******* N.B.: NESP > 1
C
         DO I1 = 1, NESP-1
            Y(I1) = MPOROY.VPOCHA(NLCE,I1)/RO
            MPOY.VPOCHA(NLCE,I1)=Y(I1)
            Y(NESP) = Y(NESP) - Y(I1)
            IF((Y(I1) .LT. YMIN) .OR. (Y(I1) .GT. YMAX))THEN
               MESERR(2) = 'Y                                      '
               VALER(2)  = Y(I1)
               LOGBOR = .TRUE.
               VAL1 = YMIN
               VAL2 = YMAX
C
C********** Y  !\in (YMIN,YMAX) : le programme s'arrete
C           mais apres le calcul des  CHPOINTs
C
            ENDIF
            CP = MLRECP.PROG(I1)
            CV = MLRECV.PROG(I1)
            CPTOT = CPTOT + Y(I1) * CP
            CVTOT = CVTOT + Y(I1) * CV
         ENDDO
         IF((Y(NESP) .LT. YMIN) .OR. (Y(NESP) .GT. YMAX))THEN
            MESERR(2) = 'Y                                       '
            VALER(2)  = Y(NESP)
            LOGBOR = .TRUE.
            VAL1 = YMIN
            VAL2 = YMAX
C
C********** Y !\in (YMIN,YMAX) : le programme s'arrete
C           mais apres le calcul des  CHPOINTs
C
         ENDIF
         CP = MLRECP.PROG(NESP)
         CV = MLRECV.PROG(NESP)
         CPTOT = CPTOT + Y(NESP) * CP
         CVTOT = CVTOT + Y(NESP) * CV
         GAMMA = CPTOT / CVTOT
         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
         MPOGAM.VPOCHA(NLCE,1) = GAMMA
C
C******* P -> MPOPRE
C        T -> MPOTEM
C
         P = (GAMMA - 1.0D0)*RETHER
         T = RETHER / RO / CVTOT
         IF(P .LE. 0.0D0)THEN
            VALER(1) = P
            MESERR(1) = 'P                                      '
            LOGNEG = .TRUE.
C
C********** P < 0: le programme s'arrete mais apres le calcul des
C                   CHPOINTs
C
         ENDIF
         MPOPRE.VPOCHA(NLCE,1) = P
         MPOTEM.VPOCHA(NLCE,1) = T
      ENDDO
C
 9999 CONTINUE
C
      SEGDES MPORO
      SEGDES MPOROV
      SEGDES MPOROE
      SEGDES MPOROY
      SEGDES MPOVIT
      SEGDES MPOPRE
      SEGDES MPOY
      SEGDES MPOGAM
      SEGDES MPOTEM
      SEGDES MSOUPY
C
      RETURN
      END
 
 
 
 
 
 
 

© Cast3M 2003 - Tous droits réservés.
Mentions légales