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

Annotation of /trunk/libf/regr1_step_av.f90

Parent Directory Parent Directory | Revision Log Revision Log

Revision 13 - (hide annotations)
Fri Jul 25 19:59:34 2008 UTC (15 years, 10 months ago) by guez
File size: 6110 byte(s) 
-- Minor change of behaviour:

"etat0" does not compute "rugsrel" nor "radpas". Deleted arguments
"radpas" and "rugsrel" of "phyredem". Deleted argument "rugsrel" of
"phyetat0". "startphy.nc" does not contain the variable "RUGSREL". In
"physiq", "rugoro" is set to 0 if not "ok_orodr". The whole program
"etat0_lim" does not use "clesphys2".

-- Minor modification of input/output:

Created subroutine "read_clesphys2". Variables of "clesphys2" are read
in "read_clesphys2" instead of "conf_gcm". "printflag" does not print
variables of "clesphys2".

-- Should not change any result at run time:

References to module "numer_rec" instead of individual modules of
"Numer_rec_Lionel".

Deleted argument "clesphy0" of "calfis", "physiq", "conf_gcm",
"leapfrog", "phyetat0". Deleted variable "clesphy0" in
"gcm". "phyetat0" does not modify variables of "clesphys2".

The program unit "gcm" does not modify "itau_phy".

Added some "intent" attributes.

"regr11_lint" does not call "polint".
1 guez 9 module regr1_step_av_m
2    
3     implicit none
4    
5     interface regr1_step_av
6    
7     ! Each procedure regrids a step function by averaging it.
8     ! The regridding operation is done on the first dimension of the
9     ! input array.
10     ! Source grid contains edges of steps.
11     ! Target grid contains positions of cell edges.
12     ! The target grid should be included in the source grid: no
13     ! extrapolation is allowed.
14     ! The difference between the procedures is the rank of the first argument.
15    
16     module procedure regr11_step_av, regr12_step_av, regr13_step_av
17     end interface
18    
19     private
20     public regr1_step_av
21    
22     contains
23    
24     function regr11_step_av(vs, xs, xt) result(vt)
25    
26     ! "vs" has rank 1.
27    
28 guez 13 use numer_rec, only: assert_eq, assert, locate
29 guez 9
30     real, intent(in):: vs(:) ! values of steps on the source grid
31     ! (Step "is" is between "xs(is)" and "xs(is + 1)".)
32    
33     real, intent(in):: xs(:)
34     ! (edges of of steps on the source grid, in strictly increasing order)
35    
36     real, intent(in):: xt(:)
37     ! (edges of cells of the target grid, in strictly increasing order)
38    
39     real vt(size(xt) - 1) ! average values on the target grid
40     ! (Cell "it" is between "xt(it)" and "xt(it + 1)".)
41    
42     ! Variables local to the procedure:
43     integer is, it, ns, nt
44     real left_edge
45    
46     !---------------------------------------------
47    
48     ns = assert_eq(size(vs), size(xs) - 1, "regr11_step_av ns")
49     nt = size(xt) - 1
50     ! Quick check on sort order:
51     call assert(xs(1) < xs(2), "regr11_step_av xs bad order")
52     call assert(xt(1) < xt(2), "regr11_step_av xt bad order")
53    
54     call assert(xs(1) <= xt(1) .and. xt(nt + 1) <= xs(ns + 1), &
55     "regr11_step_av extrapolation")
56    
57     is = locate(xs, xt(1)) ! 1 <= is <= ns, because we forbid extrapolation
58     do it = 1, nt
59     ! 1 <= is <= ns
60     ! xs(is) <= xt(it) < xs(is + 1)
61     ! Compute "vt(it)":
62     left_edge = xt(it)
63     vt(it) = 0.
64     do while (xs(is + 1) < xt(it + 1))
65     ! 1 <= is <= ns - 1
66     vt(it) = vt(it) + (xs(is + 1) - left_edge) * vs(is)
67     is = is + 1
68     left_edge = xs(is)
69     end do
70     ! 1 <= is <= ns
71     vt(it) = (vt(it) + (xt(it + 1) - left_edge) * vs(is)) &
72     / (xt(it + 1) - xt(it))
73     if (xs(is + 1) == xt(it + 1)) is = is + 1
74     ! 1 <= is <= ns .or. it == nt
75     end do
76    
77     end function regr11_step_av
78    
79     !********************************************
80    
81     function regr12_step_av(vs, xs, xt) result(vt)
82    
83     ! "vs" has rank 2.
84    
85 guez 13 use numer_rec, only: assert_eq, assert, locate
86 guez 9
87     real, intent(in):: vs(:, :) ! values of steps on the source grid
88     ! (Step "is" is between "xs(is)" and "xs(is + 1)".)
89    
90     real, intent(in):: xs(:)
91     ! (edges of steps on the source grid, in strictly increasing order)
92    
93     real, intent(in):: xt(:)
94     ! (edges of cells of the target grid, in strictly increasing order)
95    
96     real vt(size(xt) - 1, size(vs, 2)) ! average values on the target grid
97     ! (Cell "it" is between "xt(it)" and "xt(it + 1)".)
98    
99     ! Variables local to the procedure:
100     integer is, it, ns, nt
101     real left_edge
102    
103     !---------------------------------------------
104    
105     ns = assert_eq(size(vs, 1), size(xs) - 1, "regr12_step_av ns")
106     nt = size(xt) - 1
107    
108     ! Quick check on sort order:
109     call assert(xs(1) < xs(2), "regr12_step_av xs bad order")
110     call assert(xt(1) < xt(2), "regr12_step_av xt bad order")
111    
112     call assert(xs(1) <= xt(1) .and. xt(nt + 1) <= xs(ns + 1), &
113     "regr12_step_av extrapolation")
114    
115     is = locate(xs, xt(1)) ! 1 <= is <= ns, because we forbid extrapolation
116     do it = 1, nt
117     ! 1 <= is <= ns
118     ! xs(is) <= xt(it) < xs(is + 1)
119     ! Compute "vt(it, :)":
120     left_edge = xt(it)
121     vt(it, :) = 0.
122     do while (xs(is + 1) < xt(it + 1))
123     ! 1 <= is <= ns - 1
124     vt(it, :) = vt(it, :) + (xs(is + 1) - left_edge) * vs(is, :)
125     is = is + 1
126     left_edge = xs(is)
127     end do
128     ! 1 <= is <= ns
129     vt(it, :) = (vt(it, :) + (xt(it + 1) - left_edge) * vs(is, :)) &
130     / (xt(it + 1) - xt(it))
131     if (xs(is + 1) == xt(it + 1)) is = is + 1
132     ! 1 <= is <= ns .or. it == nt
133     end do
134    
135     end function regr12_step_av
136    
137     !********************************************
138    
139     function regr13_step_av(vs, xs, xt) result(vt)
140    
141     ! "vs" has rank 3.
142    
143 guez 13 use numer_rec, only: assert_eq, assert, locate
144 guez 9
145     real, intent(in):: vs(:, :, :) ! values of steps on the source grid
146     ! (Step "is" is between "xs(is)" and "xs(is + 1)".)
147    
148     real, intent(in):: xs(:)
149     ! (edges of steps on the source grid, in strictly increasing order)
150    
151     real, intent(in):: xt(:)
152     ! (edges of cells of the target grid, in strictly increasing order)
153    
154     real vt(size(xt) - 1, size(vs, 2), size(vs, 3))
155     ! (average values on the target grid)
156     ! (Cell "it" is between "xt(it)" and "xt(it + 1)".)
157    
158     ! Variables local to the procedure:
159     integer is, it, ns, nt
160     real left_edge
161    
162     !---------------------------------------------
163    
164     ns = assert_eq(size(vs, 1), size(xs) - 1, "regr13_step_av ns")
165     nt = size(xt) - 1
166    
167     ! Quick check on sort order:
168     call assert(xs(1) < xs(2), "regr13_step_av xs bad order")
169     call assert(xt(1) < xt(2), "regr13_step_av xt bad order")
170    
171     call assert(xs(1) <= xt(1) .and. xt(nt + 1) <= xs(ns + 1), &
172     "regr13_step_av extrapolation")
173    
174     is = locate(xs, xt(1)) ! 1 <= is <= ns, because we forbid extrapolation
175     do it = 1, nt
176     ! 1 <= is <= ns
177     ! xs(is) <= xt(it) < xs(is + 1)
178     ! Compute "vt(it, :, :)":
179     left_edge = xt(it)
180     vt(it, :, :) = 0.
181     do while (xs(is + 1) < xt(it + 1))
182     ! 1 <= is <= ns - 1
183     vt(it, :, :) = vt(it, :, :) + (xs(is + 1) - left_edge) * vs(is, :, :)
184     is = is + 1
185     left_edge = xs(is)
186     end do
187     ! 1 <= is <= ns
188     vt(it, :, :) = (vt(it, :, :) &
189     + (xt(it + 1) - left_edge) * vs(is, :, :)) / (xt(it + 1) - xt(it))
190     if (xs(is + 1) == xt(it + 1)) is = is + 1
191     ! 1 <= is <= ns .or. it == nt
192     end do
193    
194     end function regr13_step_av
195    
196     end module regr1_step_av_m
  ViewVC Help
Powered by ViewVC 1.1.21