source: LMDZ6/branches/blowing_snow/libf/misc/pchfe_95_m.F90 @ 5420

Last change on this file since 5420 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: 2.7 KB
Line 
1module PCHFE_95_m
2
3  implicit none
4
5contains
6
7  SUBROUTINE PCHFE_95(X, F, D, SKIP, XE, FE, IERR)
8
9    ! PURPOSE  Evaluate a piecewise cubic Hermite function at an array of
10    !            points.  May be used by itself for Hermite interpolation,
11    !            or as an evaluator for PCHIM or PCHIC.
12    ! CATEGORY  E3
13    ! KEYWORDS  CUBIC HERMITE EVALUATION, HERMITE INTERPOLATION, PCHIP,
14    !             PIECEWISE CUBIC EVALUATION
15
16    !          PCHFE:  Piecewise Cubic Hermite Function Evaluator
17    ! Evaluates the cubic Hermite function defined by  X, F, D  at
18    ! the points  XE.
19
20    use assert_eq_m, only: assert_eq
21
22    REAL, intent(in):: X(:) ! real array of independent variable values
23    ! The elements of X must be strictly increasing.
24
25    REAL, intent(in):: F(:) ! real array of function values
26    ! F(I) is the value corresponding to X(I).
27
28    REAL, intent(in):: D(:) ! real array of derivative values
29    ! D(I) is the value corresponding to X(I).
30
31    LOGICAL, intent(inout):: SKIP
32    ! request to skip checks for validity of "x"
33    ! If "skip" is false then "pchfe" will check that size(x) >= 2 and
34    ! "x" is in strictly ascending order.
35    ! Setting "skip" to true will save time in case these checks have
36    ! already been performed (say, in "PCHIM" or "PCHIC").
37    ! "SKIP" will be set to TRUE on normal return.
38
39    real, intent(in):: XE(:) ! points at which the function is to be evaluated
40    ! NOTES:
41    ! 1. The evaluation will be most efficient if the elements of XE
42    ! are increasing relative to X.
43    ! That is,   XE(J) .GE. X(I)
44    ! implies    XE(K) .GE. X(I),  all K.GE.J
45    ! 2. If any of the XE are outside the interval [X(1),X(N)], values
46    ! are extrapolated from the nearest extreme cubic, and a warning
47    ! error is returned.
48
49    real, intent(out):: FE(:) ! values of the cubic Hermite function
50    ! defined by X, F, D at the points XE
51
52    integer, intent(out):: IERR ! error flag
53    ! Normal return:
54    ! IERR = 0  no error
55    ! Warning error:
56    ! IERR > 0  means that extrapolation was performed at IERR points
57    ! "Recoverable" errors:
58    !              IERR = -1  if N < 2
59    !              IERR = -3  if the X-array is not strictly increasing
60    !              IERR = -4  if NE < 1
61    ! NOTE: The above errors are checked in the order listed, and
62    ! following arguments have **NOT** been validated.
63
64    ! Variables local to the procedure:
65
66    INTEGER  N, NE
67
68    !---------------------------------------
69
70    n = assert_eq(size(x), size(f), size(d), "PCHFE_95 n")
71    ne = assert_eq(size(xe), size(fe), "PCHFE_95 ne")
72    call PCHFE(N, X, F, D, 1, SKIP, NE, XE, FE, IERR)
73
74  end SUBROUTINE PCHFE_95
75
76end module PCHFE_95_m
Note: See TracBrowser for help on using the repository browser.