C FUNCO1    SOURCE    BECC      09/12/07    21:15:29     6579           
      SUBROUTINE FUNCO1(NORDP1,TMAXCV,
     &                  RG,ACVTOG,ROG,TG,RTG,ETHEG,UG,GAMG,CG,
     &                  TGS,RTGS,CVGS,ROGS,PGS,ETHEGS,UGS,
     &                  DELSGS,UMXSOL,UPXSOL,
     &                  RC1,AEQ1,XSOL,
     &                  LOGEQ,DUDT,DPDT)
C************************************************************************
C
C PROJET            :  CASTEM 2000
C
C NOM               :  FUNCO1 (voir FUNCOL)
C
C DESCRIPTION       :  Calcul de l'etat choc (u-cg) et des certains
C                      parametres utilises pour le calcul de dp/du 
C
C LANGAGE           :  FORTRAN 77 
C      
C AUTEUR            :  A. BECCANTINI DRN/DMT/SEMT/LTMF  
C
C************************************************************************
C
C APPELES           :  NONE
C
C************************************************************************
C
C
C**** ENTREES: 
C
C             NORDP1   = degree des polynoms cv+1
C             TMAXCV   = temperature de seuil pour cv(T)
C             RG       = R du gaz a gauche
C             ACVTOT_j = \sum_{i=1,nesp} Y_i*ACV_{i,j}
C             ROG      = masse volumique a gauche
C             TG       = temperature a gauche
C             RTG      = RG * TG = PG / ROG
C             ETHEG    = energie thermique a gauche
C             UG       = vitesse absolute a gauche
C             GAMG     = CPG / CVG
C             CG       = vitesse du son a gauche
C             TGS      = temperature a droite
C
C**** SORTIES:
C
C             RTGS     = RG*TGS
C             CVGS     = CV a droite
C             ROGS     = masse volumique a droite
C             PGS      = pression a droite
C             ETHEGS   = energie thermique a droite
C             DELSGS,UMXSOL,UPXSOL,RC1,AEQ1,XSOL 
C                      = parameters pour determiner le jacobian
C             LOGEQ    = logical: si .TRUE., TG = TGS et le jacobian
C                        est stoke en DUDT,DPDT
C
C************************************************************************
C
C HISTORIQUE (Anomalies et modifications éventuelles)
C
C HISTORIQUE : Créé le 07.12.09 
C
C************************************************************************
C
C N.B.: Toutes les variables sont DECLAREES
C                          
      IMPLICIT INTEGER(I-N)
      INTEGER NORDP1,I1
      REAL*8 TMAXCV, T2
      REAL*8 RG,ACVTOG(*),ROG,TG,RTG,ETHEG,UG,CG,GAMG
     &      ,TGS,CVGS,ROGS,PGS,ETHEGS,UGS
     &      ,RTGS,DELSGS,UMXSOL,UPXSOL,UMSUP,RC1
     &      ,DPDU,DPDT,DUDT,VAL
     &      ,FUNT,FUNCV,XSOL,AEQ2,AEQ1,SIGNUM
      LOGICAL LOGEQ
C
C**** Logeq = .TRUE. -> TGS = TG
C                       On calcule aussi DPDT,DUDT
C                       Pour l'etat on utilize le meme formules 
C                       que dans le cas LOGEQ = .FALSE.
C
      LOGEQ = ABS(TGS - TG) .LE. (1.0D-2 * TG)
C
C**** Calcul de ETHEGS, CVGS
C     
C     t2 = min (tgs, Tmaxcv)
      T2 = 0.5D0 * ((TGS + TMAXCV) - ABS (TGS - TMAXCV))
      CVGS = ACVTOG(1)
      ETHEGS = T2 * CVGS
      FUNT = 1.0D0
      DO I1 = 2, NORDP1, 1
         FUNT = FUNT * T2
         FUNCV = ACVTOG(I1) * FUNT
         CVGS = CVGS + FUNCV
         ETHEGS = ETHEGS + (FUNCV * T2/ I1)
      ENDDO
C     t2 = max ((tgs - Tmaxcv),0)
      T2 = 0.5D0 * ((TGS - TMAXCV) + ABS (TGS - TMAXCV))
      ETHEGS = ETHEGS + (CVGS * T2)
C
      RTGS = RG * TGS
C
C**** XSOL = ROG / ROGS
C     XSOL t.c. RTG XSOL*XSOL + AEQ1 * XSOL - RTGS = 0
C
      AEQ2 = RTG
      AEQ1 = 2.0D0 * (ETHEGS - ETHEG) + RTGS - AEQ2
      DELSGS = SQRT((AEQ1 * AEQ1) + (4.0D0 * RTGS * AEQ2))
      XSOL = (DELSGS - AEQ1) / (2.0D0 * AEQ2)
      ROGS = ROG / XSOL
C
C**** UGS, PGS
C
      RC1 = AEQ1 + RTGS  - AEQ2
C
C     RC1 = 2.0D0*(HTHEGS - HTHEG)
C
C**** XSOL > 1  -> TG > TGS -> RC1 < 0
C
      UMXSOL = 1.0D0 - XSOL
      SIGNUM = SIGN(1.0D0,UMXSOL)
      UPXSOL = 1.0D0 + XSOL
      UMSUP =  UMXSOL / UPXSOL
      VAL = RC1 * UMSUP
C
C**** VAL > 0
C
      VAL = SQRT(ABS(VAL))
      UGS = UG - SIGNUM*VAL
      PGS = RTGS * ROGS
C
C**** DUDT, DPDT
C
      IF(LOGEQ)THEN
         DPDU = -1.0D0 * ROG * CG
         DPDT = (GAMG * PGS) / ((GAMG - 1.0D0) * TG)
         DUDT = DPDT / DPDU
      ELSE
C
C******* Initialisazion a zero (il sont calcules ailleur)
C      
         DPDT = 0.0D0
         DUDT = 0.0D0
      ENDIF
C
      RETURN
      END