1 |
module inter_barx_m |
2 |
|
3 |
implicit none |
4 |
|
5 |
contains |
6 |
|
7 |
function inter_barx(dlonid, fdat, rlonimod) |
8 |
|
9 |
! From dyn3d/inter_barx.F, version 1.1.1.1, 2004/05/19 12:53:06 |
10 |
|
11 |
! Authors: Robert Sadourny, P. Le Van |
12 |
|
13 |
! Interpolation barycentrique bas\'ee sur les aires. Version |
14 |
! unidimensionnelle, en longitude. |
15 |
|
16 |
use nr_util, only: assert_eq, pi |
17 |
|
18 |
REAL, intent(in):: dlonid(:) ! (idatmax) |
19 |
! abscisses des interfaces des mailles donn\'ees |
20 |
|
21 |
real, intent(in):: fdat(:) ! (idatmax) champ de donn\'ees |
22 |
|
23 |
real, intent(in):: rlonimod(:) ! (imodmax) |
24 |
! Abscisses des interfaces des mailles mod\`ele. L'indice 1 |
25 |
! correspond a l'interface maille 1 / maille 2. Les abscisses sont |
26 |
! exprim\'ees en degres. |
27 |
|
28 |
real inter_barx(size(rlonimod)) ! champ du mod\`ele |
29 |
|
30 |
! Local: |
31 |
INTEGER idatmax, imodmax |
32 |
REAL xxid(size(dlonid)+1), xxd(size(dlonid)+1), fdd(size(dlonid)+1) |
33 |
REAL fxd(size(dlonid)+1), xchan(size(dlonid)+1), fdchan(size(dlonid)+1) |
34 |
REAL xxim(size(rlonimod)) |
35 |
REAL x0, xim0, dx, dxm |
36 |
REAL chmax |
37 |
integer idat ! indice du champ de donnees, de 1 a idatmax |
38 |
INTEGER imod ! indice du champ du modele, de 1 a imodmax |
39 |
integer i, ichang, id0, id1, nid, idatmax1 |
40 |
|
41 |
!----------------------------------------------------- |
42 |
|
43 |
idatmax = assert_eq(size(dlonid), size(fdat), "inter_barx idatmax") |
44 |
imodmax = size(rlonimod) |
45 |
|
46 |
! Red\'efinition de l'origine des abscisses \`a l'interface ouest de |
47 |
! la premi\`ere maille du mod\`ele |
48 |
DO imod = 1, imodmax |
49 |
xxim(imod) = rlonimod(imod) |
50 |
ENDDO |
51 |
|
52 |
chmax = maxval(xxim) |
53 |
IF(chmax < 6.50) THEN |
54 |
DO imod = 1, imodmax |
55 |
xxim(imod) = xxim(imod) * 180./pi |
56 |
ENDDO |
57 |
ENDIF |
58 |
|
59 |
xim0 = xxim(imodmax) - 360. |
60 |
|
61 |
DO imod = 1, imodmax |
62 |
xxim(imod) = xxim(imod) - xim0 |
63 |
ENDDO |
64 |
|
65 |
idatmax1 = idatmax +1 |
66 |
|
67 |
DO idat = 1, idatmax |
68 |
xxd(idat) = dlonid(idat) |
69 |
ENDDO |
70 |
|
71 |
chmax = maxval(xxd(:idatmax)) |
72 |
IF(chmax < 6.50) THEN |
73 |
DO idat = 1, idatmax |
74 |
xxd(idat) = xxd(idat) * 180./pi |
75 |
ENDDO |
76 |
ENDIF |
77 |
|
78 |
DO idat = 1, idatmax |
79 |
xxd(idat) = AMOD(xxd(idat) - xim0, 360.) |
80 |
fdd(idat) = fdat (idat) |
81 |
ENDDO |
82 |
|
83 |
i = 2 |
84 |
DO while (xxd(i) >= xxd(i-1) .and. i < idatmax) |
85 |
i = i + 1 |
86 |
ENDDO |
87 |
IF (xxd(i) < xxd(i-1)) THEN |
88 |
ichang = i |
89 |
! R\'eorganisation des longitudes entre 0 et 360 degr\'es |
90 |
nid = idatmax - ichang +1 |
91 |
DO i = 1, nid |
92 |
xchan (i) = xxd(i+ichang -1) |
93 |
fdchan(i) = fdd(i+ichang -1) |
94 |
ENDDO |
95 |
DO i=1, ichang -1 |
96 |
xchan (i+ nid) = xxd(i) |
97 |
fdchan(i+nid) = fdd(i) |
98 |
ENDDO |
99 |
DO i =1, idatmax |
100 |
xxd(i) = xchan(i) |
101 |
fdd(i) = fdchan(i) |
102 |
ENDDO |
103 |
end IF |
104 |
|
105 |
! Translation des champs de donn\'ees par rapport \`a la nouvelle |
106 |
! origine, avec redondance de la maille \`a cheval sur les bords |
107 |
|
108 |
id0 = 0 |
109 |
id1 = 0 |
110 |
|
111 |
DO idat = 1, idatmax |
112 |
IF (xxd(idatmax1- idat) < 360.) exit |
113 |
id1 = id1 + 1 |
114 |
ENDDO |
115 |
|
116 |
DO idat = 1, idatmax |
117 |
IF (xxd(idat) > 0.) exit |
118 |
id0 = id0 + 1 |
119 |
END DO |
120 |
|
121 |
IF(id1 /= 0) then |
122 |
DO idat = 1, id1 |
123 |
xxid(idat) = xxd(idatmax - id1 + idat) - 360. |
124 |
fxd (idat) = fdd(idatmax - id1 + idat) |
125 |
END DO |
126 |
DO idat = 1, idatmax - id1 |
127 |
xxid(idat + id1) = xxd(idat) |
128 |
fxd (idat + id1) = fdd(idat) |
129 |
END DO |
130 |
end IF |
131 |
|
132 |
IF(id0 /= 0) then |
133 |
DO idat = 1, idatmax - id0 |
134 |
xxid(idat) = xxd(idat + id0) |
135 |
fxd (idat) = fdd(idat + id0) |
136 |
END DO |
137 |
|
138 |
DO idat = 1, id0 |
139 |
xxid (idatmax - id0 + idat) = xxd(idat) + 360. |
140 |
fxd (idatmax - id0 + idat) = fdd(idat) |
141 |
END DO |
142 |
else |
143 |
DO idat = 1, idatmax |
144 |
xxid(idat) = xxd(idat) |
145 |
fxd (idat) = fdd(idat) |
146 |
ENDDO |
147 |
end IF |
148 |
xxid(idatmax1) = xxid(1) + 360. |
149 |
fxd (idatmax1) = fxd(1) |
150 |
|
151 |
! Initialisation du champ du mod\`ele |
152 |
|
153 |
inter_barx(:) = 0. |
154 |
|
155 |
! Iteration |
156 |
|
157 |
x0 = xim0 |
158 |
dxm = 0. |
159 |
imod = 1 |
160 |
idat = 1 |
161 |
|
162 |
do while (imod <= imodmax) |
163 |
do while (xxim(imod) > xxid(idat)) |
164 |
dx = xxid(idat) - x0 |
165 |
dxm = dxm + dx |
166 |
inter_barx(imod) = inter_barx(imod) + dx * fxd(idat) |
167 |
x0 = xxid(idat) |
168 |
idat = idat + 1 |
169 |
end do |
170 |
IF (xxim(imod) < xxid(idat)) THEN |
171 |
dx = xxim(imod) - x0 |
172 |
dxm = dxm + dx |
173 |
inter_barx(imod) = (inter_barx(imod) + dx * fxd(idat)) / dxm |
174 |
x0 = xxim(imod) |
175 |
dxm = 0. |
176 |
imod = imod + 1 |
177 |
ELSE |
178 |
dx = xxim(imod) - x0 |
179 |
dxm = dxm + dx |
180 |
inter_barx(imod) = (inter_barx(imod) + dx * fxd(idat)) / dxm |
181 |
x0 = xxim(imod) |
182 |
dxm = 0. |
183 |
imod = imod + 1 |
184 |
idat = idat + 1 |
185 |
END IF |
186 |
end do |
187 |
|
188 |
END function inter_barx |
189 |
|
190 |
end module inter_barx_m |