C FUNCOL    SOURCE    CHAT      05/01/13    00:11:39     5004
      SUBROUTINE FUNCOL(NORDP1,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               :  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             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 08.02.00
C
C************************************************************************
C
C N.B.: Toutes les variables sont DECLAREES
C
      IMPLICIT INTEGER(I-N)
      INTEGER NORDP1,I1
      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
      CVGS = ACVTOG(1)
      ETHEGS = TGS * CVGS
      FUNT = 1.0D0
      DO I1 = 2, NORDP1, 1
         FUNT = FUNT * TGS
         FUNCV = ACVTOG(I1) * FUNT
         CVGS = CVGS + FUNCV
         ETHEGS = ETHEGS + (FUNCV * TGS/ I1)
      ENDDO
      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