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