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

Contents of /trunk/libf/regr1_step_av.f90

Parent Directory Parent Directory | Revision Log Revision Log

Revision 13 - (show 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 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 use numer_rec, only: assert_eq, assert, locate
29
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 use numer_rec, only: assert_eq, assert, locate
86
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 use numer_rec, only: assert_eq, assert, locate
144
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