C PRIDE1 SOURCE BECC 10/06/23 21:15:01 6691 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) < 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 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,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 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 <= 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