1 |
guez |
7 |
module regr3_lint_m |
2 |
|
|
|
3 |
|
|
implicit none |
4 |
|
|
|
5 |
|
|
interface regr3_lint |
6 |
|
|
! Each procedure regrids by linear interpolation. |
7 |
|
|
! The regridding operation is done on the third dimension of the |
8 |
|
|
! input array. |
9 |
|
|
! The difference betwwen the procedures is the rank of the first argument. |
10 |
|
|
module procedure regr33_lint |
11 |
|
|
end interface |
12 |
|
|
|
13 |
|
|
private |
14 |
|
|
public regr3_lint |
15 |
|
|
|
16 |
|
|
contains |
17 |
|
|
|
18 |
|
|
function regr33_lint(vs, xs, xt) result(vt) |
19 |
|
|
|
20 |
|
|
! "vs" has rank 3. |
21 |
|
|
|
22 |
guez |
13 |
use numer_rec, only: assert_eq, hunt |
23 |
guez |
7 |
|
24 |
|
|
real, intent(in):: vs(:, :, :) |
25 |
|
|
! (values of the function at source points "xs") |
26 |
|
|
|
27 |
|
|
real, intent(in):: xs(:) |
28 |
|
|
! (abscissas of points in source grid, in strictly monotonic order) |
29 |
|
|
|
30 |
|
|
real, intent(in):: xt(:) |
31 |
|
|
! (abscissas of points in target grid) |
32 |
|
|
|
33 |
|
|
real vt(size(vs, 1), size(vs, 2), size(xt)) |
34 |
|
|
! (values of the function on the target grid) |
35 |
|
|
|
36 |
|
|
! Variables local to the procedure: |
37 |
|
|
integer is, it, ns |
38 |
|
|
integer is_b ! "is" bound between 1 and "ns - 1" |
39 |
|
|
|
40 |
|
|
!-------------------------------------- |
41 |
|
|
|
42 |
|
|
ns = assert_eq(size(vs, 3), size(xs), "regr33_lint ns") |
43 |
|
|
|
44 |
|
|
is = -1 ! go immediately to bisection on first call to "hunt" |
45 |
|
|
|
46 |
|
|
do it = 1, size(xt) |
47 |
|
|
call hunt(xs, xt(it), is) |
48 |
|
|
is_b = min(max(is, 1), ns - 1) |
49 |
|
|
vt(:, :, it) = ((xs(is_b+1) - xt(it)) * vs(:, :, is_b) & |
50 |
|
|
+ (xt(it) - xs(is_b)) * vs(:, :, is_b+1)) / (xs(is_b+1) - xs(is_b)) |
51 |
|
|
end do |
52 |
|
|
|
53 |
|
|
end function regr33_lint |
54 |
|
|
|
55 |
|
|
end module regr3_lint_m |