C VALPAR    SOURCE    CHAT      05/01/13    04:00:47     5004
      SUBROUTINE VALPAR(COURB,NPTEUR,NCOURB,NC,X,Y,YPRIM,T,
     & TINF,TSUP,COURB1,NC1)
C
C---------------------------------------------------------------------
C Objet: calcul de la valeur d'une fonction F et de sa derivee
C        en un point X donne et pour une valeur de T precisee.
C        Cette fonction est discretisee en NPTS points et connue
C        pour differentes valeurs du parametre T.
C        Elle est tabulee de la facon suivante suivante:
C        COURB(T1,X1,F(X1),X2,F(X2),.....,T2,Y1,F(Y1),Y2,F(Y2),...)
C---------------------------------------------------------------------
C
C---------------------------------------------------------------------
C Entree: NPTEUR(NC) tableau contenant les nombres de points de
C          discretisation pour chaque courbe a T fixee.
C          Ex: si NPTEUR(1)=20 alors pour la valeur T=T1 la fonction
C         Y=F(X,T1) est discretisee sur 20 points.
C         NC nombre de courbes connues pour T1,T2,....
C         NCOURB dimension du tableau COURB
C         COURB(NCOURB) tableau decrit ci-dessus
C         COURB1(NC1) tableau de travail
C         X,T point et parametre d'interpolation
C---------------------------------------------------------------------
C
C---------------------------------------------------------------------
C Sortie: Y=F(X,T) valeur interpolee de la fonction F au point (X,T)
C---------------------------------------------------------------------
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
      DIMENSION NPTEUR(*),COURB(*),COURB1(*)
C
C--------------------------------------
C Courbe independante de la temperature
C--------------------------------------
      IF (NC.EQ.1) THEN
                        TINF=T
                        TSUP=T
                        LTINF=0
                        LTSUP=0
                        NPTINF=NPTEUR(1)
                        NPTSUP=NPTEUR(1)
                        GOTO 100
      ENDIF
C
C------------------------------------------------------
C Recherche des temperatures extremes connues TMIN,TMAX
C------------------------------------------------------
      TMIN=COURB(1)
      KT=0
      DO 5 I=1,NC-1
5     KT=KT+NPTEUR(I)
      KT=2*KT
      KT=KT+NC
      TMAX=COURB(KT)
C
C---------------------------------------------------------------------
C T plus petit que la plus petite des temperatures ou plus grande que
C               la plus grande des temperatures
C---------------------------------------------------------------------
      IF (T.LT.TMIN) THEN
                         TINF=T
                         TSUP=T
                         LTINF=1
                         LTSUP=1
                         NPTINF=NPTEUR(1)
                         NPTSUP=NPTEUR(1)
                         GOTO 100
      ENDIF
      IF (T.GE.TMAX) THEN
                         TINF=T
                         TSUP=T
                         LTINF=KT
                         LTSUP=KT
                         NPTINF=NPTEUR(NC)
                         NPTSUP=NPTEUR(NC)
                         GOTO 100
      ENDIF
C
C---------------------------------------------------------------------
C Recherche de l'intervalle de temperature [TINF,TSUP] comprenant T
C---------------------------------------------------------------------
      I=1
      KC=1
30    CONTINUE
      NPTINF=NPTEUR(KC)
      IF ( T.LT.COURB(I+2*NPTINF+1) ) THEN
          LTINF=I
          LTSUP=I+2*NPTINF+1
          TINF=COURB(LTINF)
          TSUP=COURB(LTSUP)
          NPTSUP=NPTEUR(KC+1)
          GOTO 100
        ELSE
          I=I+2*NPTINF+1
          KC=KC+1
          GOTO 30
      ENDIF
C
100   CONTINUE
C
C--------------------------------------------------------------------
C Sauvegarde des courbes de F(X,T) pour TINF et TSUP
C--------------------------------------------------------------------
      N1=2*NPTINF
      DO 50 J=1,N1
50      COURB1(J)=COURB(J+LTINF)
C--------------------
C Calcul de F(X,TINF)
C
      CALL DERTRA(N1,COURB1,X,Y1,YPRIM1,XINF,XSUP)
C
      N2=2*NPTSUP
      DO 60 J=1,N2
60      COURB1(J)=COURB(J+LTSUP)
C--------------------
C Calcul de F(X,TSUP)
C
      CALL DERTRA(N2,COURB1,X,Y2,YPRIM2,XINF,XSUP)
C
C-------------------------------------------------------------------
C  T appartenant a [TINF,TSUP] i.e T=TETA*TINF+(1-TETA)*TSUP
C  F(X,T)=TETA*F(X,TINF)+(1-TETA)*F(X,TSUP)
C-------------------------------------------------------------------
      IF (TINF.EQ.TSUP) THEN
          TETA=0.
        ELSE
          TETA=(T-TSUP)/(TINF-TSUP)
      ENDIF
      Y=TETA*Y1+(1-TETA)*Y2
      YPRIM=TETA*YPRIM1+(1-TETA)*YPRIM2
C
      RETURN
      END


