Esope source files

   1 : C VALPAR    SOURCE    CHAT      05/01/13    04:00:47     5004           
   2 :       SUBROUTINE VALPAR(COURB,NPTEUR,NCOURB,NC,X,Y,YPRIM,T,
   3 :      & TINF,TSUP,COURB1,NC1)
   4 : C
   5 : C---------------------------------------------------------------------
   6 : C Objet: calcul de la valeur d'une fonction F et de sa derivee
   7 : C        en un point X donne et pour une valeur de T precisee.
   8 : C        Cette fonction est discretisee en NPTS points et connue
   9 : C        pour differentes valeurs du parametre T.
  10 : C        Elle est tabulee de la facon suivante suivante:
  11 : C        COURB(T1,X1,F(X1),X2,F(X2),.....,T2,Y1,F(Y1),Y2,F(Y2),...)
  12 : C---------------------------------------------------------------------
  13 : C
  14 : C---------------------------------------------------------------------
  15 : C Entree: NPTEUR(NC) tableau contenant les nombres de points de
  16 : C          discretisation pour chaque courbe a T fixee.
  17 : C          Ex: si NPTEUR(1)=20 alors pour la valeur T=T1 la fonction 
  18 : C         Y=F(X,T1) est discretisee sur 20 points. 
  19 : C         NC nombre de courbes connues pour T1,T2,....
  20 : C         NCOURB dimension du tableau COURB
  21 : C         COURB(NCOURB) tableau decrit ci-dessus
  22 : C         COURB1(NC1) tableau de travail
  23 : C         X,T point et parametre d'interpolation
  24 : C---------------------------------------------------------------------
  25 : C
  26 : C---------------------------------------------------------------------
  27 : C Sortie: Y=F(X,T) valeur interpolee de la fonction F au point (X,T)
  28 : C---------------------------------------------------------------------
  29 : C  
  30 :       IMPLICIT INTEGER(I-N)
  31 :       IMPLICIT REAL*8(A-H,O-Z)   
  32 :       DIMENSION NPTEUR(*),COURB(*),COURB1(*)
  33 : C
  34 : C--------------------------------------
  35 : C Courbe independante de la temperature
  36 : C--------------------------------------
  37 :       IF (NC.EQ.1) THEN 
  38 :                         TINF=T
  39 :                         TSUP=T
  40 :                         LTINF=0
  41 :                         LTSUP=0
  42 :                         NPTINF=NPTEUR(1)
  43 :                         NPTSUP=NPTEUR(1)
  44 :                         GOTO 100
  45 :       ENDIF
  46 : C
  47 : C------------------------------------------------------
  48 : C Recherche des temperatures extremes connues TMIN,TMAX 
  49 : C------------------------------------------------------
  50 :       TMIN=COURB(1)
  51 :       KT=0
  52 :       DO 5 I=1,NC-1
  53 : 5     KT=KT+NPTEUR(I)
  54 :       KT=2*KT
  55 :       KT=KT+NC
  56 :       TMAX=COURB(KT)
  57 : C
  58 : C---------------------------------------------------------------------
  59 : C T plus petit que la plus petite des temperatures ou plus grande que
  60 : C               la plus grande des temperatures
  61 : C---------------------------------------------------------------------
  62 :       IF (T.LT.TMIN) THEN
  63 :                          TINF=T
  64 :                          TSUP=T
  65 :                          LTINF=1
  66 :                          LTSUP=1
  67 :                          NPTINF=NPTEUR(1)
  68 :                          NPTSUP=NPTEUR(1)
  69 :                          GOTO 100
  70 :       ENDIF
  71 :       IF (T.GE.TMAX) THEN
  72 :                          TINF=T
  73 :                          TSUP=T
  74 :                          LTINF=KT
  75 :                          LTSUP=KT
  76 :                          NPTINF=NPTEUR(NC)
  77 :                          NPTSUP=NPTEUR(NC)
  78 :                          GOTO 100
  79 :       ENDIF
  80 : C
  81 : C---------------------------------------------------------------------
  82 : C Recherche de l'intervalle de temperature [TINF,TSUP] comprenant T
  83 : C---------------------------------------------------------------------
  84 :       I=1
  85 :       KC=1
  86 : 30    CONTINUE
  87 :       NPTINF=NPTEUR(KC)
  88 :       IF ( T.LT.COURB(I+2*NPTINF+1) ) THEN
  89 :           LTINF=I
  90 :           LTSUP=I+2*NPTINF+1
  91 :           TINF=COURB(LTINF)
  92 :           TSUP=COURB(LTSUP)
  93 :           NPTSUP=NPTEUR(KC+1)
  94 :           GOTO 100
  95 :         ELSE
  96 :           I=I+2*NPTINF+1
  97 :           KC=KC+1
  98 :           GOTO 30
  99 :       ENDIF
 100 : C
 101 : 100   CONTINUE
 102 : C
 103 : C--------------------------------------------------------------------
 104 : C Sauvegarde des courbes de F(X,T) pour TINF et TSUP
 105 : C--------------------------------------------------------------------
 106 :       N1=2*NPTINF
 107 :       DO 50 J=1,N1
 108 : 50      COURB1(J)=COURB(J+LTINF)
 109 : C--------------------
 110 : C Calcul de F(X,TINF) 
 111 : C
 111 :       CALL DERTRA(N1,COURB1,X,Y1,YPRIM1,XINF,XSUP)
 112 : C
 113 :       N2=2*NPTSUP
 114 :       DO 60 J=1,N2
 115 : 60      COURB1(J)=COURB(J+LTSUP)
 116 : C--------------------
 117 : C Calcul de F(X,TSUP)
 118 : C
 118 :       CALL DERTRA(N2,COURB1,X,Y2,YPRIM2,XINF,XSUP)
 119 : C
 120 : C-------------------------------------------------------------------         
 121 : C  T appartenant a [TINF,TSUP] i.e T=TETA*TINF+(1-TETA)*TSUP 
 122 : C  F(X,T)=TETA*F(X,TINF)+(1-TETA)*F(X,TSUP)
 123 : C-------------------------------------------------------------------
 124 :       IF (TINF.EQ.TSUP) THEN
 125 :           TETA=0.
 126 :         ELSE
 127 :           TETA=(T-TSUP)/(TINF-TSUP) 
 128 :       ENDIF
 129 :       Y=TETA*Y1+(1-TETA)*Y2
 130 :       YPRIM=TETA*YPRIM1+(1-TETA)*YPRIM2
 131 : C
 132 :       RETURN
 133 :       END
 134 :  
 135 :