Changeset 1263 for LMDZ4/branches/LMDZ4-dev/libf/bibio/regr3_lint_m.F90
- Timestamp:
- Nov 17, 2009, 2:00:14 PM (15 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ4/branches/LMDZ4-dev/libf/bibio/regr3_lint_m.F90
r1157 r1263 11 11 ! input array. 12 12 ! The difference betwwen the procedures is the rank of the first argument. 13 module procedure regr33_lint 13 module procedure regr33_lint, regr34_lint 14 14 end interface 15 15 … … 57 57 end function regr33_lint 58 58 59 !********************************************************* 60 61 function regr34_lint(vs, xs, xt) result(vt) 62 63 ! "vs" has rank 4. 64 65 use assert_eq_m, only: assert_eq 66 use interpolation, only: hunt 67 68 real, intent(in):: vs(:, :, :, :) 69 ! (values of the function at source points "xs") 70 71 real, intent(in):: xs(:) 72 ! (abscissas of points in source grid, in strictly monotonic order) 73 74 real, intent(in):: xt(:) 75 ! (abscissas of points in target grid) 76 77 real vt(size(vs, 1), size(vs, 2), size(xt), size(vs, 4)) 78 ! (values of the function on the target grid) 79 80 ! Variables local to the procedure: 81 integer is, it, ns 82 integer is_b ! "is" bound between 1 and "ns - 1" 83 84 !-------------------------------------- 85 86 ns = assert_eq(size(vs, 3), size(xs), "regr34_lint ns") 87 88 is = -1 ! go immediately to bisection on first call to "hunt" 89 90 do it = 1, size(xt) 91 call hunt(xs, xt(it), is) 92 is_b = min(max(is, 1), ns - 1) 93 vt(:, :, it, :) = ((xs(is_b+1) - xt(it)) * vs(:, :, is_b, :) & 94 + (xt(it) - xs(is_b)) * vs(:, :, is_b+1, :)) & 95 / (xs(is_b+1) - xs(is_b)) 96 end do 97 98 end function regr34_lint 99 59 100 end module regr3_lint_m
Note: See TracChangeset
for help on using the changeset viewer.