source: LMDZ6/branches/cirrus/libf/misc/pchdf.F @ 5434

Last change on this file since 5434 was 1907, checked in by lguez, 11 years ago

Added a copyright property to every file of the distribution, except
for the fcm files (which have their own copyright). Use svn propget on
a file to see the copyright. For instance:

$ svn propget copyright libf/phylmd/physiq.F90
Name of program: LMDZ
Creation date: 1984
Version: LMDZ5
License: CeCILL version 2
Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
See the license file in the root directory

Also added the files defining the CeCILL version 2 license, in French
and English, at the top of the LMDZ tree.

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
File size: 3.1 KB
Line 
1*DECK PCHDF
2      REAL FUNCTION PCHDF (K, X, S, IERR)
3C***BEGIN PROLOGUE  PCHDF
4C***SUBSIDIARY
5C***PURPOSE  Computes divided differences for PCHCE and PCHSP
6C***LIBRARY   SLATEC (PCHIP)
7C***TYPE      SINGLE PRECISION (PCHDF-S, DPCHDF-D)
8C***AUTHOR  Fritsch, F. N., (LLNL)
9C***DESCRIPTION
10C
11C          PCHDF:   PCHIP Finite Difference Formula
12C
13C     Uses a divided difference formulation to compute a K-point approx-
14C     imation to the derivative at X(K) based on the data in X and S.
15C
16C     Called by  PCHCE  and  PCHSP  to compute 3- and 4-point boundary
17C     derivative approximations.
18C
19C ----------------------------------------------------------------------
20C
21C     On input:
22C        K      is the order of the desired derivative approximation.
23C               K must be at least 3 (error return if not).
24C        X      contains the K values of the independent variable.
25C               X need not be ordered, but the values **MUST** be
26C               distinct.  (Not checked here.)
27C        S      contains the associated slope values:
28C                  S(I) = (F(I+1)-F(I))/(X(I+1)-X(I)), I=1(1)K-1.
29C               (Note that S need only be of length K-1.)
30C
31C     On return:
32C        S      will be destroyed.
33C        IERR   will be set to -1 if K.LT.2 .
34C        PCHDF  will be set to the desired derivative approximation if
35C               IERR=0 or to zero if IERR=-1.
36C
37C ----------------------------------------------------------------------
38C
39C***SEE ALSO  PCHCE, PCHSP
40C***REFERENCES  Carl de Boor, A Practical Guide to Splines, Springer-
41C                 Verlag, New York, 1978, pp. 10-16.
42C***ROUTINES CALLED  XERMSG
43C***REVISION HISTORY  (YYMMDD)
44C   820503  DATE WRITTEN
45C   820805  Converted to SLATEC library version.
46C   870813  Minor cosmetic changes.
47C   890411  Added SAVE statements (Vers. 3.2).
48C   890411  REVISION DATE from Version 3.2
49C   891214  Prologue converted to Version 4.0 format.  (BAB)
50C   900315  CALLs to XERROR changed to CALLs to XERMSG.  (THJ)
51C   900328  Added TYPE section.  (WRB)
52C   910408  Updated AUTHOR and DATE WRITTEN sections in prologue.  (WRB)
53C   920429  Revised format and order of references.  (WRB,FNF)
54C   930503  Improved purpose.  (FNF)
55C***END PROLOGUE  PCHDF
56C
57C**End
58C
59C  DECLARE ARGUMENTS.
60C
61      INTEGER  K, IERR
62      REAL  X(K), S(K)
63C
64C  DECLARE LOCAL VARIABLES.
65C
66      INTEGER  I, J
67      REAL  VALUE, ZERO
68      SAVE ZERO
69      DATA  ZERO /0./
70C
71C  CHECK FOR LEGAL VALUE OF K.
72C
73C***FIRST EXECUTABLE STATEMENT  PCHDF
74      IF (K .LT. 3)  GO TO 5001
75C
76C  COMPUTE COEFFICIENTS OF INTERPOLATING POLYNOMIAL.
77C
78      DO 10  J = 2, K-1
79         DO 9  I = 1, K-J
80            S(I) = (S(I+1)-S(I))/(X(I+J)-X(I))
81    9    CONTINUE
82   10 CONTINUE
83C
84C  EVALUATE DERIVATIVE AT X(K).
85C
86      VALUE = S(1)
87      DO 20  I = 2, K-1
88         VALUE = S(I) + VALUE*(X(K)-X(I))
89   20 CONTINUE
90C
91C  NORMAL RETURN.
92C
93      IERR = 0
94      PCHDF = VALUE
95      RETURN
96C
97C  ERROR RETURN.
98C
99 5001 CONTINUE
100C     K.LT.3 RETURN.
101      IERR = -1
102      CALL XERMSG ('SLATEC', 'PCHDF', 'K LESS THAN THREE', IERR, 1)
103      PCHDF = ZERO
104      RETURN
105C------------- LAST LINE OF PCHDF FOLLOWS ------------------------------
106      END
Note: See TracBrowser for help on using the repository browser.