Télécharger primi2.eso

Retour à la liste

primi2
C PRIMI2    SOURCE    CB215821  20/11/25    13:36:57     10792          
      SUBROUTINE PRIMI2(NESP,NORDP1,NSCA,PROPHY,
     &            ICEN,IRO,IROVIT,IROET,IROY,IROSCA,LOGTEM,IT,
     &            IVIT,IPRES,ITEMP,IY,ISCA,IGAM,
     &            LOGAN,LOGNEG,LOGBOR,LOGIPG,LOGNC,MESERR,
     &            VALER,VAL1,VAL2)
C
C************************************************************************
C
C PROJET            :  CASTEM 2000
C
C NOM               :  PRIMI2
C
C DESCRIPTION       :  VOIR PRIMI1
C
C                      Melange des gaz "thermally 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            NORDP1  : ordre des polynoms du cv_i + 1
C
C            NSCA    : nombre scalaires passif splittés
C
C            PROPHY  : pointeur sur un segment qui contient les
C                      proprietes du 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            IROSCA  : CHPOINT  contenant les scalaires passifs splittes
C                      fois la masse;
C
C            LOGTEM  : si .TRUE., la temperature de premier tentative
C                      pour Newton-Rapson est donne;
C
C            IT      : pointeur sur ls CHPOINT de la temperature de
C                      premier tentative;
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            ISCA    : CHPOINT  contenant les scalaires passifs splittes;
C
C            IGAM    : CHPOINT  contenant les "gamma" du gaz;
C
C            LOGAN   : anomalie detectée
C
C            LOGNEG  : (LOGICAL): si .TRUE. une densité ou  un temperature
C                      negative a été detectée -> le programme s'arrete
C                      et on peut visualiser le champe de densite ou de
C                      temperature (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                      gamma a été detecté dehor GAMMIN et GAMMAX
C                      (sa valeur stockée en MESERR(2) et
C                      VALER(2),VAL1,VAL2)
C
C            LOGIPG  : si .TRUE., cv(T) < 0
C
C            LOGNC   : si .TRUE., Newton Rapson pour le calcul de T
C                      n'a pas converge
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 16.12.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,NORDP1,NSCA
     &       ,ICEN,IRO,IROVIT,IROET,IROY,IROSCA
     &       ,IVIT,IPRES,IY,ISCA,IGAM,IGEOMC
     &       ,N1,NLCE,I1,ITEMP,IT,I2
C
C**** NESP = Nombre d'especes dans le gaz.
C
      REAL*8   EPSI,VALER(2),VAL1,VAL2
     &        ,YMIN,YMAX
     &        ,RO,UX,UY,UZ,RETOT,ETHER,CELL
     &        ,RTOT,CVTOT,T0
     &        ,GAMMA,GAMMIN,GAMMAX
     &        ,T
      CHARACTER*(8) TYPE
      CHARACTER*(40) MESERR(2)
      LOGICAL LOGNEG, LOGBOR, LOGAN, LOGNC, LOGIPG, LOGTEM
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, MPOTET.MPOVAL, MPOROS.MPOVAL,
     &         MPOSCA.MPOVAL, MSOUPS.MSOUPO
-INC SMELEME
C
C**** Y(NESP)
C
      SEGMENT FRAMAS
         REAL*8 Y(NESP)
      ENDSEGMENT
      SEGINI FRAMAS
C
C**** Segment du propriete du gaz
C
      SEGMENT PROPHY
         REAL*8 ACV(NORD+1,NESP), R(NESP), HOK(NESP)
      ENDSEGMENT
C
C**** Initialisation des variables pour la gestion des erreurs pas ici,
C     mais avant
C
      SEGMENT SUMCV
         REAL*8 ACVTOT(NORDP1)
      ENDSEGMENT
      SEGINI SUMCV
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
      IF(IROY .GT. 0)THEN
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
         SEGDES MSOUPY
         IY = MCHPO2
      ELSE
         IY=0
      ENDIF
C
C***  ISCA
C
C     Ce CHPOINT ressemble à IROSCA
C     Donc on lit IROSCA
C
      IF(IROSCA .GT. 0)THEN
         MCHPO1 = IROSCA
         SEGACT MCHPO1
         MSOUPS = MCHPO1.IPCHP(1)
         SEGDES MCHPO1
         SEGACT MSOUPS
         MPOROS = MSOUPS.IPOVAL
         SEGACT MPOROS
C
         SEGINI, MPOSCA = MPOROS
         SEGINI, MSOUP2 = MSOUPS
         MSOUP2.IPOVAL = MPOSCA
         SEGINI, MCHPO2 = MCHPO1
         MCHPO2.IPCHP(1)= MSOUP2
         SEGDES MSOUP2
         SEGDES MCHPO2
         SEGDES MSOUPS
         ISCA = MCHPO2
      ELSE
         ISCA = 0
      ENDIF
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**** Temperature de premier tentative
C
      IF(LOGTEM)THEN
         CALL LICHT(IT,MPOTET,TYPE,IGEOMC)
      ELSE
         SEGINI, MPOTET = MPOROE
         DO I1=1,N1
            MPOTET.VPOCHA(I1,1) = 600
         ENDDO
      ENDIF
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 (si NESP >1)
C     MPOROS < -- > ROS (si NSCA >1)
C     MPOVIT < -- > IVIT
C     MPOPRE < -- > IPRES
C     MPOTEM < -- > ITEM
C     MPOY   < -- > IY (si NESP > 1)
C     MPOSCA < -- > ISCA (si NSCA > 1)
C     MPOGAM < -- > IGAM
C     MPOTET < -- > Temperature de premier tentative
C
C   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, ETHER
C
         RETOT = MPOROE.VPOCHA(NLCE,1)
         ETHER = RETOT - CELL
         ETHER = ETHER / RO
C
C******* Y
C
C        On a utilisé le ponteur par defaut,
C        i.e. Y(I1) = FRAMAS.Y(I1)
C
C
         Y(NESP) = 1.0D0
C
C******* SUMCV.ACVTOT a ZERO
C
         DO I1 = 1, NORDP1
            SUMCV.ACVTOT(I1) = 0.0D0
         ENDDO
C
C******* N.B.: NESP => 1
C
         RTOT = 0.0D0
         IF(NESP .GT. 1)THEN
            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
               DO I2 = 1, NORDP1
                  SUMCV.ACVTOT(I2) = SUMCV.ACVTOT(I2) +
     &                               (Y(I1) * PROPHY.ACV(I2,I1))
               ENDDO
               RTOT = RTOT +  Y(I1) * PROPHY.R(I1)
            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
         ENDIF
         DO I2 = 1, NORDP1
            SUMCV.ACVTOT(I2) = SUMCV.ACVTOT(I2)
     &                         + (Y(NESP) * PROPHY.ACV(I2,NESP))
         ENDDO
         RTOT = RTOT + Y(NESP) * PROPHY.R(NESP)
         IF(RTOT .LE. 0.0D0)THEN
            LOGIPG = .TRUE.
         ENDIF
C
C******* Calcul de la temperature et de la pression
C
         T0 = MPOTET.VPOCHA(NLCE,1)
         CALL PRITEM(NORDP1,SUMCV.ACVTOT,ETHER,T0,T,LOGNC,LOGIPG)
         MPOTEM.VPOCHA(NLCE,1) = T
         MPOPRE.VPOCHA(NLCE,1) = RTOT * T * RO
         IF(T .LE. 0.0D0)THEN
            VALER(1) = T
            MESERR(1) = 'T                                       '
            LOGNEG = .TRUE.
C
C********** T < 0: le programme s'arrete mais apres le calcul des
C                   CHPOINTs
C
         ENDIF
 
C
C******* Calcul du GAMMA
C
C        Le CV
C
         CVTOT = SUMCV.ACVTOT(1)
         T0 = 1.0D0
         DO I1 = 2, NORDP1
            T0 = T0 * T
            CELL = SUMCV.ACVTOT(I1) * T0
            CVTOT = CVTOT + CELL
         ENDDO
         GAMMA = (CVTOT + RTOT) / 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******* Calcul du vecteur de scalaire
C
         DO I1 = 1, NSCA, 1
            MPOSCA.VPOCHA(NLCE,I1) = MPOROS.VPOCHA(NLCE,I1) / RO
         ENDDO
C
C**** Fin boucle sur les points
C
      ENDDO
C
 9999 CONTINUE
C
      SEGDES MPORO
      SEGDES MPOROV
      SEGDES MPOROE
      IF(NESP .GT. 1)THEN
         SEGDES MPOROY
         SEGDES MPOY
      ENDIF
      IF(NSCA .GE. 1)THEN
         SEGDES MPOROS
         SEGDES MPOSCA
      ENDIF
      SEGDES MPOVIT
      SEGDES MPOPRE
      SEGDES MPOGAM
      SEGDES MPOTEM
      IF(LOGTEM)THEN
         SEGDES MPOTET
      ELSE
         SEGSUP MPOTET
      ENDIF
      SEGSUP FRAMAS
      SEGSUP SUMCV
C
      RETURN
      END
 
 
 
 
 
 
 
 

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