/[lmdze]/trunk/libf/regr3_lint.f90
ViewVC logotype

Diff of /trunk/libf/regr3_lint.f90

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 13 by guez, Fri Jul 25 19:59:34 2008 UTC revision 36 by guez, Thu Dec 2 17:11:04 2010 UTC
# Line 1  Line 1 
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
# Line 7  module regr3_lint_m Line 9  module regr3_lint_m
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
# Line 19  contains Line 21  contains
21    
22      ! "vs" has rank 3.      ! "vs" has rank 3.
23    
24      use numer_rec, only: assert_eq, hunt      use nr_util, only: assert_eq
25        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")
# Line 52  contains Line 55  contains
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
Legend:
Removed from v.13  
changed lines
  Added in v.36
  ViewVC Help
Powered by ViewVC 1.1.21