Sources Esope | Cast3M

pride1
C PRIDE1    SOURCE    OF166741  24/12/13    21:17:10     12097          
      SUBROUTINE PRIDE1(NESP,NORD,TMAX,RUNIV,PROPHY,
     &     MLRCHE,MLRMFR,
     &     ICEN,IALP1,IALP2,IARN1,IARN2,IAGN1,IAGN2,IARET1,IARET2,
     &     ITG1,ITG2,
     &     IRN1,IRN2,
     &     IVN1,IVN2,IPN1,IPN2,ITN1,ITN2,
     &     EPS,
     &     LOGAN,LOGIPG,LOGNEG,LOGBOR,LOGNC,
     &     VALER,VAL1,VAL2)
C
C************************************************************************
C
C PROJET            :  CASTEM 2000
C
C NOM               :  PRIDE1
C
C DESCRIPTION       :  VOIR PRIDEM
C
C                      Melange des gaz "reactive thermally perfect".
C
C                      Calcul de la vitesse, de la pression, de la
C                      temperature
C
C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
C
C AUTEUR            :  A. BECCANTINI, DEN/DM2S/SFME/TTMF
C
C************************************************************************
C
C APPELES de calcul :  CONTHE
C
C************************************************************************
C
C ENTREES  : NESP    : nombre d'especes dans le melange.
C
C            NORD    : ordre des polynoms du cv_i
C
C            TMAX    : maximum temperature for cv expansion
C
C            RUNIV   : universal constant for gases
C
C            PROPHY  : thermodynamic properties for the gases
C
C            MLRCHE  : LISTREEL with the coefS involved in the chemical
C                      reaction
C
C            MLRMFR  : LISTREEL with the mass fractions before or after
C                      the chemical reaction
C
C            ICEN    : MELEME of the mesh
C
C            IALP1, IALP2, IARN1, IARN2, IAGN1, IAGN2, IARET1, IARET2,
C            ITG1, ITG2 : pointeurs of the input CHAMPOINs
C
C            IRN1, IRN2, IVN1, IVN2, IPN1, IPN2, ITN1, ITN2:
C            pointeurs of the input CHAMPOINs
C
C SORTIES  :
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
C            LOGIPG  : si .TRUE., cv(T) &lt; 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 06.11.09.
C
C************************************************************************
C
C**** Les variables
C
      IMPLICIT INTEGER(I-N)
      INTEGER NESP,NORD
     &       ,ICEN,IALP1,IALP2,IARN1,IARN2,IAGN1,IAGN2,IARET1,IARET2
     &       ,ITG1,ITG2
     &       ,IRN1, IRN2, IVN1, IVN2, IPN1, IPN2, ITN1, ITN2
     &       ,N1,NLCE,IESP,IGEOMC
C
C**** NESP = Nombre d'especes dans le gaz.
C
      REAL*8   RUNIV, TMAX, EPSI, VALER(2), VAL1, VAL2
     &        , YMIN, YMAX
     &        , EPS
     &        , UX, UY, UZ, RO, ALPHA, T, P
     &        , YNESPI, YNESPF
     &        , ACOE1, YINI, YFIN, DYCO, UVEC(5), TGUESS
      CHARACTER*(8) TYPE
      CHARACTER*(40) MESERR(2)
      LOGICAL LOGNEG, LOGBOR, LOGAN, LOGNC, LOGIPG
C
C**** Valeur minimum di Y
C
C     N.B.: il doit etre le meme dans gamma.eso.
C
      PARAMETER(EPSI=1.0D-4,
     &          YMIN=-EPSI,YMAX=1.0D0+EPSI)
C
C**** Les includes
C
 
-INC PPARAM
-INC CCOPTIO
-INC SMCHPOI
      POINTEUR MPALP1.MPOVAL, MPALP2.MPOVAL,
     &     MPARO1.MPOVAL, MPARO2.MPOVAL,
     &     MPAGN1.MPOVAL, MPAGN2.MPOVAL,
     &     MPARE1.MPOVAL, MPARE2.MPOVAL,
     &     MPOTG1.MPOVAL, MPOTG2.MPOVAL,
     &     MPOVN1.MPOVAL, MPOVN2.MPOVAL,
     &     MPOPN1.MPOVAL, MPOPN2.MPOVAL,
     &     MPORN1.MPOVAL, MPORN2.MPOVAL,
     &     MPOTN1.MPOVAL, MPOTN2.MPOVAL
-INC SMLREEL
      POINTEUR MLRCHE.MLREEL, MLRMFR.MLREEL,
     &     MLRYIN.MLREEL, MLRYFI.MLREEL
-INC SMELEME
C
C**** Segment du propriete du gaz
C
      SEGMENT PROPHY
         REAL*8 ACV(NORD+1,NESP), W(NESP), H0K(NESP)
      ENDSEGMENT
      SEGACT PROPHY
C
C**** Initialisation des variables pour la gestion des erreurs pas ici,
C     mais avant
C
      SEGMENT SUMCV
         REAL*8 ACVTOT(NORD+1)
      ENDSEGMENT
      SEGINI SUMCV
C
C**** Activation du MELEME "CENTRE"
C
      IPT1 = ICEN
      SEGACT IPT1
      N1 = IPT1.NUM(/2)
      SEGDES IPT1
C
C**** Lecture des MPOVALs
C
      CALL LICHT(IALP1, MPALP1,TYPE,IGEOMC)
      CALL LICHT(IARN1, MPARO1,TYPE,IGEOMC)
      CALL LICHT(IAGN1, MPAGN1,TYPE,IGEOMC)
      CALL LICHT(IARET1,MPARE1,TYPE,IGEOMC)
      CALL LICHT(ITG1,  MPOTG1,TYPE,IGEOMC)
      CALL LICHT(IVN1,  MPOVN1,TYPE,IGEOMC)
      CALL LICHT(IPN1,  MPOPN1,TYPE,IGEOMC)
      CALL LICHT(IRN1,  MPORN1,TYPE,IGEOMC)
      CALL LICHT(ITN1,  MPOTN1,TYPE,IGEOMC)
C
      CALL LICHT(IALP2,MPALP2,TYPE,IGEOMC)
      CALL LICHT(IARN2,MPARO2,TYPE,IGEOMC)
      CALL LICHT(IAGN2,MPAGN2,TYPE,IGEOMC)
      CALL LICHT(IARET2,MPARE2,TYPE,IGEOMC)
      CALL LICHT(ITG2,MPOTG2,TYPE,IGEOMC)
      CALL LICHT(IVN2,MPOVN2,TYPE,IGEOMC)
      CALL LICHT(IPN2,MPOPN2,TYPE,IGEOMC)
      CALL LICHT(IRN2,MPORN2,TYPE,IGEOMC)
      CALL LICHT(ITN2,MPOTN2,TYPE,IGEOMC)
C
C**** LICHT active les MPOVALs en *MOD
C
C     i.e.
C
C     SEGACT
C
C
C**** Computation of the mass fractions
C
      SEGACT MLRMFR
      SEGACT MLRCHE
      SEGINI, MLRYIN = MLRMFR
      SEGINI, MLRYFI = MLRMFR
      YNESPI = 1.0D0
      YNESPF = 1.0D0
      ACOE1 = MLRCHE.PROG(1)
      IF (ACOE1 .LE. 0.0D0)THEN
         WRITE(IOIMP,*) 'TAB1 . CHEMCOEF = ???                   '
         WRITE(IOIMP,*) 'First coefficient &lt;= 0                  '
         CALL ERREUR(21)
         GOTO 9999
      ENDIF
      YINI   = MLRMFR.PROG(1)
      YFIN   = MLRMFR.PROG(2)
      YNESPF = YNESPF - YFIN
      YNESPI = YNESPI - YINI
      MLRYIN.PROG(1) = YINI
      MLRYFI.PROG(1) = YFIN
      DYCO = (YINI - YFIN) / (ACOE1 *  PROPHY.W(1))
      IF((YINI .LT. YMIN) .OR. (YINI .GT. YMAX))THEN
         MESERR(2) = 'YINI                                    '
         VALER(2)  = YINI
         LOGBOR = .TRUE.
         VAL1 = YMIN
         VAL2 = YMAX
      ENDIF
      IF((YFIN .LT. YMIN) .OR. (YFIN .GT. YMAX))THEN
         MESERR(2) = 'YFIN                                    '
         VALER(2)  = YFIN
         LOGBOR = .TRUE.
         VAL1 = YMIN
         VAL2 = YMAX
      ENDIF
      DO IESP = 2 , (NESP - 1), 1
         ACOE1 = MLRCHE.PROG(IESP)
         IF (ACOE1 .GT. 0.0D0) THEN
            YFIN   = MLRMFR.PROG(IESP + 1)
            YINI = YFIN + (DYCO * (ACOE1 * PROPHY.W(IESP)))
         ELSE
            YINI = MLRMFR.PROG(IESP + 1)
            YFIN = YINI - (DYCO * (ACOE1 * PROPHY.W(IESP)))
         ENDIF
         MLRYFI.PROG(IESP) = YFIN
         MLRYIN.PROG(IESP) = YINI
         YNESPF = YNESPF - YFIN
         YNESPI = YNESPI - YINI
         IF((YINI .LT. YMIN) .OR. (YINI .GT. YMAX))THEN
            MESERR(2) = 'YINI                                    '
            VALER(2)  = YINI
            LOGBOR = .TRUE.
            VAL1 = YMIN
            VAL2 = YMAX
         ENDIF
         IF((YFIN .LT. YMIN) .OR. (YFIN .GT. YMAX))THEN
            MESERR(2) = 'YFIN                                    '
            VALER(2)  = YFIN
            LOGBOR = .TRUE.
            VAL1 = YMIN
            VAL2 = YMAX
         ENDIF
      ENDDO
      IF((YNESPI .LT. YMIN) .OR. (YNESPI .GT. YMAX))THEN
         MESERR(2) = 'YNESPI                                  '
         VALER(2)  = YNESPI
         LOGBOR = .TRUE.
         VAL1 = YMIN
         VAL2 = YMAX
      ENDIF
      IF((YNESPF .LT. YMIN) .OR. (YNESPF .GT. YMAX))THEN
         MESERR(2) = 'YFIN                                    '
         VALER(2)  = YFIN
         LOGBOR = .TRUE.
         VAL1 = YMIN
         VAL2 = YMAX
      ENDIF
      MLRYFI.PROG(NESP) = YNESPF
      MLRYIN.PROG(NESP) = YNESPI
C
c      write(*,*) 'Initial mass fractions'
c      do iesp = 1 , nesp
c         write(*,*) iesp, mlryin.prog(iesp)
c      enddo
c      write(*,*) 'Final mass fractions'
c      do iesp = 1 , nesp
c         write(*,*) mlryfi.prog(iesp)
c      enddo
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
         ALPHA = MPALP1.VPOCHA(NLCE,1)
         IF (ALPHA .GT. EPS) THEN
            RO = MPARO1.VPOCHA(NLCE,1) / ALPHA
            UVEC(1)   = RO
            IF(RO .LE. 0.0D0)THEN
               VALER(1) = RO
               MESERR(1) = 'RO                                      '
               LOGNEG = .TRUE.
               GOTO 9999
            ENDIF
            UVEC(2) = MPAGN1.VPOCHA(NLCE,1) / ALPHA
            UVEC(3) = MPAGN1.VPOCHA(NLCE,2) / ALPHA
            IF (IDIM .EQ. 3) THEN
               UVEC(4) = MPAGN1.VPOCHA(NLCE,3) / ALPHA
            ELSE
               UVEC(4) = 0.0D0
            ENDIF
            UVEC(5) = MPARE1.VPOCHA(NLCE,1) / ALPHA
            TGUESS = MPOTG1.VPOCHA(NLCE,1)
            CALL CONTHE(NESP, NORD, PROPHY.ACV, PROPHY.W, PROPHY.H0K,
     &           RUNIV, TMAX, UVEC, MLRYIN.PROG,
     &           TGUESS,
     &           SUMCV.ACVTOT,
     &           UX, UY, UZ, P, T,
     &           LOGIPG, LOGNC, LOGNEG, VALER, MESERR)
            IF (LOGNC .OR. LOGNEG)THEN
               GOTO 9999
            ENDIF
            MPOVN1.VPOCHA(NLCE,1) = UX
            MPOVN1.VPOCHA(NLCE,2) = UY
            IF (IDIM .EQ. 3) THEN
               MPOVN1.VPOCHA(NLCE,3) = UZ
            ENDIF
            MPOTN1.VPOCHA(NLCE,1) = T
            MPOPN1.VPOCHA(NLCE,1) = P
            MPORN1.VPOCHA(NLCE,1) = RO
         ENDIF
C
         ALPHA = MPALP2.VPOCHA(NLCE,1)
         IF (ALPHA .GT. EPS) THEN
            RO = MPARO2.VPOCHA(NLCE,1) / ALPHA
            UVEC(1)   = RO
            IF(RO .LE. 0.0D0)THEN
               VALER(1) = RO
               MESERR(1) = 'RO                                      '
               LOGNEG = .TRUE.
               GOTO 9999
            ENDIF
            UVEC(2) = MPAGN2.VPOCHA(NLCE,1) / ALPHA
            UVEC(3) = MPAGN2.VPOCHA(NLCE,2) / ALPHA
            IF (IDIM .EQ. 3) THEN
               UVEC(4) = MPAGN2.VPOCHA(NLCE,3) / ALPHA
            ELSE
               UVEC(4) = 0.0D0
            ENDIF
            UVEC(5) = MPARE2.VPOCHA(NLCE,1) / ALPHA
            TGUESS = MPOTG2.VPOCHA(NLCE,1)
            CALL CONTHE(NESP, NORD, PROPHY.ACV, PROPHY.W, PROPHY.H0K,
     &           RUNIV, TMAX, UVEC, MLRYFI.PROG,
     &           TGUESS,
     &           SUMCV.ACVTOT,
     &           UX, UY, UZ, P, T,
     &           LOGIPG, LOGNC, LOGNEG, VALER, MESERR)
            IF (LOGNC .OR. LOGNEG)THEN
               GOTO 9999
            ENDIF
            MPOVN2.VPOCHA(NLCE,1) = UX
            MPOVN2.VPOCHA(NLCE,2) = UY
            IF (IDIM .EQ. 3) THEN
               MPOVN2.VPOCHA(NLCE,3) = UZ
            ENDIF
            MPOTN2.VPOCHA(NLCE,1) = T
            MPOPN2.VPOCHA(NLCE,1) = P
            MPORN2.VPOCHA(NLCE,1) = RO
         ENDIF
C
C**** Fin boucle sur les points
C
      ENDDO
C
 9999 CONTINUE
C
      SEGDES MPALP1
      SEGDES MPARO1
      SEGDES MPAGN1
      SEGDES MPARE1
      SEGDES MPOTG1
      SEGDES MPOVN1
      SEGDES MPOPN1
      SEGDES MPORN1
      SEGDES MPOTN1
      SEGDES MPALP2
      SEGDES MPARO2
      SEGDES MPAGN2
      SEGDES MPARE2
      SEGDES MPOTG2
      SEGDES MPOVN2
      SEGDES MPOPN2
      SEGDES MPORN2
      SEGDES MPOTN2
C
      SEGDES PROPHY
C
      SEGDES MLRMFR
      SEGDES MLRCHE
C
      SEGSUP MLRYIN
      SEGSUP MLRYFI
      SEGSUP SUMCV
C
      RETURN
      END