1 |
module regr3_lint_m |
module regr3_lint_m |
2 |
|
|
3 |
|
! Author: Lionel GUEZ |
4 |
|
|
5 |
implicit none |
implicit none |
6 |
|
|
7 |
interface regr3_lint |
interface regr3_lint |
9 |
! The regridding operation is done on the third dimension of the |
! The regridding operation is done on the third dimension of the |
10 |
! input array. |
! input array. |
11 |
! The difference betwwen the procedures is the rank of the first argument. |
! The difference betwwen the procedures is the rank of the first argument. |
12 |
module procedure regr33_lint |
module procedure regr33_lint, regr34_lint |
13 |
end interface |
end interface |
14 |
|
|
15 |
private |
private |
21 |
|
|
22 |
! "vs" has rank 3. |
! "vs" has rank 3. |
23 |
|
|
24 |
use nrutil, only: assert_eq |
use nr_util, only: assert_eq |
25 |
use interpolation, only: hunt |
use numer_rec, only: hunt |
26 |
|
|
27 |
real, intent(in):: vs(:, :, :) |
real, intent(in):: vs(:, :, :) |
28 |
! (values of the function at source points "xs") |
! (values of the function at source points "xs") |
55 |
|
|
56 |
end function regr33_lint |
end function regr33_lint |
57 |
|
|
58 |
|
!********************************************************* |
59 |
|
|
60 |
|
function regr34_lint(vs, xs, xt) result(vt) |
61 |
|
|
62 |
|
! "vs" has rank 4. |
63 |
|
|
64 |
|
use nr_util, only: assert_eq |
65 |
|
use numer_rec, only: hunt |
66 |
|
|
67 |
|
real, intent(in):: vs(:, :, :, :) |
68 |
|
! (values of the function at source points "xs") |
69 |
|
|
70 |
|
real, intent(in):: xs(:) |
71 |
|
! (abscissas of points in source grid, in strictly monotonic order) |
72 |
|
|
73 |
|
real, intent(in):: xt(:) |
74 |
|
! (abscissas of points in target grid) |
75 |
|
|
76 |
|
real vt(size(vs, 1), size(vs, 2), size(xt), size(vs, 4)) |
77 |
|
! (values of the function on the target grid) |
78 |
|
|
79 |
|
! Variables local to the procedure: |
80 |
|
integer is, it, ns |
81 |
|
integer is_b ! "is" bound between 1 and "ns - 1" |
82 |
|
|
83 |
|
!-------------------------------------- |
84 |
|
|
85 |
|
ns = assert_eq(size(vs, 3), size(xs), "regr34_lint ns") |
86 |
|
|
87 |
|
is = -1 ! go immediately to bisection on first call to "hunt" |
88 |
|
|
89 |
|
do it = 1, size(xt) |
90 |
|
call hunt(xs, xt(it), is) |
91 |
|
is_b = min(max(is, 1), ns - 1) |
92 |
|
vt(:, :, it, :) = ((xs(is_b+1) - xt(it)) * vs(:, :, is_b, :) & |
93 |
|
+ (xt(it) - xs(is_b)) * vs(:, :, is_b+1, :)) & |
94 |
|
/ (xs(is_b+1) - xs(is_b)) |
95 |
|
end do |
96 |
|
|
97 |
|
end function regr34_lint |
98 |
|
|
99 |
end module regr3_lint_m |
end module regr3_lint_m |