4 |
|
|
5 |
contains |
contains |
6 |
|
|
|
|
|
|
!****************************** |
|
|
|
|
7 |
function inter_barx(dlonid, fdat, rlonimod) |
function inter_barx(dlonid, fdat, rlonimod) |
8 |
|
|
9 |
! From dyn3d/inter_barx.F, v 1.1.1.1 2004/05/19 12:53:06 |
! From dyn3d/inter_barx.F, version 1.1.1.1 2004/05/19 12:53:06 |
10 |
|
|
11 |
! Auteurs : Robert Sadourny, P. Le Van |
! Authors: Robert Sadourny, P. Le Van |
12 |
|
|
13 |
! INTERPOLATION BARYCENTRIQUE BASEE SUR LES AIRES |
! INTERPOLATION BARYCENTRIQUE BASEE SUR LES AIRES |
14 |
! VERSION UNIDIMENSIONNELLE , EN LONGITUDE . |
! VERSION UNIDIMENSIONNELLE, EN LONGITUDE . |
15 |
|
|
16 |
! idat : indice du champ de donnees, de 1 a idatmax |
! idat : indice du champ de donnees, de 1 a idatmax |
17 |
! imod : indice du champ du modele, de 1 a imodmax |
! imod : indice du champ du modele, de 1 a imodmax |
18 |
! fdat(idat) : champ de donnees (entrees) |
! fdat(idat) : champ de donnees (entrees) |
19 |
! inter_barx(imod) : champ du modele (sorties) |
! inter_barx(imod) : champ du modele (sorties) |
20 |
! dlonid(idat): abscisses des interfaces des mailles donnees |
! dlonid(idat): abscisses des interfaces des mailles donnees |
21 |
! rlonimod(imod): abscisses des interfaces des mailles modele |
! rlonimod(imod): abscisses des interfaces des mailles modele |
22 |
! ( L'indice 1 correspond a l'interface mailLE 1 / maille 2) |
! (L'indice 1 correspond a l'interface mailLE 1 / maille 2) |
23 |
! ( Les abscisses sont exprimées en degres) |
! (Les abscisses sont exprimées en degres) |
|
|
|
|
use nr_util, only: assert_eq |
|
24 |
|
|
25 |
|
use nr_util, only: assert_eq, pi |
26 |
|
|
27 |
REAL, intent(in):: dlonid(:) |
REAL, intent(in):: dlonid(:) |
28 |
real, intent(in):: fdat(:) |
real, intent(in):: fdat(:) |
30 |
|
|
31 |
real inter_barx(size(rlonimod)) |
real inter_barx(size(rlonimod)) |
32 |
|
|
33 |
! ... Variables locales ... |
! Variables locales |
34 |
|
|
35 |
INTEGER idatmax, imodmax |
INTEGER idatmax, imodmax |
36 |
REAL xxid(size(dlonid)+1), xxd(size(dlonid)+1), fdd(size(dlonid)+1) |
REAL xxid(size(dlonid)+1), xxd(size(dlonid)+1), fdd(size(dlonid)+1) |
37 |
REAL fxd(size(dlonid)+1), xchan(size(dlonid)+1), fdchan(size(dlonid)+1) |
REAL fxd(size(dlonid)+1), xchan(size(dlonid)+1), fdchan(size(dlonid)+1) |
38 |
REAL xxim(size(rlonimod)) |
REAL xxim(size(rlonimod)) |
39 |
|
|
40 |
REAL x0, xim0, dx, dxm |
REAL x0, xim0, dx, dxm |
41 |
REAL chmin, chmax, pi |
REAL chmin, chmax |
42 |
|
|
43 |
INTEGER imod, idat, i, ichang, id0, id1, nid, idatmax1 |
INTEGER imod, idat, i, ichang, id0, id1, nid, idatmax1 |
44 |
|
|
47 |
idatmax = assert_eq(size(dlonid), size(fdat), "inter_barx idatmax") |
idatmax = assert_eq(size(dlonid), size(fdat), "inter_barx idatmax") |
48 |
imodmax = size(rlonimod) |
imodmax = size(rlonimod) |
49 |
|
|
50 |
pi = 2. * ASIN(1.) |
! REDEFINITION DE L'ORIGINE DES ABSCISSES |
51 |
|
! A L'INTERFACE OUEST DE LA PREMIERE MAILLE DU MODELE |
|
! REDEFINITION DE L'ORIGINE DES ABSCISSES |
|
|
! A L'INTERFACE OUEST DE LA PREMIERE MAILLE DU MODELE |
|
52 |
DO imod = 1, imodmax |
DO imod = 1, imodmax |
53 |
xxim(imod) = rlonimod(imod) |
xxim(imod) = rlonimod(imod) |
54 |
ENDDO |
ENDDO |
55 |
|
|
56 |
CALL minmax( imodmax, xxim, chmin, chmax) |
CALL minmax(imodmax, xxim, chmin, chmax) |
57 |
IF( chmax.LT.6.50 ) THEN |
IF(chmax < 6.50) THEN |
58 |
DO imod = 1, imodmax |
DO imod = 1, imodmax |
59 |
xxim(imod) = xxim(imod) * 180./pi |
xxim(imod) = xxim(imod) * 180./pi |
60 |
ENDDO |
ENDDO |
72 |
xxd(idat) = dlonid(idat) |
xxd(idat) = dlonid(idat) |
73 |
ENDDO |
ENDDO |
74 |
|
|
75 |
CALL minmax( idatmax, xxd, chmin, chmax) |
CALL minmax(idatmax, xxd, chmin, chmax) |
76 |
IF( chmax.LT.6.50 ) THEN |
IF(chmax < 6.50) THEN |
77 |
DO idat = 1, idatmax |
DO idat = 1, idatmax |
78 |
xxd(idat) = xxd(idat) * 180./pi |
xxd(idat) = xxd(idat) * 180./pi |
79 |
ENDDO |
ENDDO |
80 |
ENDIF |
ENDIF |
81 |
|
|
82 |
DO idat = 1, idatmax |
DO idat = 1, idatmax |
83 |
xxd(idat) = AMOD( xxd(idat) - xim0, 360. ) |
xxd(idat) = AMOD(xxd(idat) - xim0, 360.) |
84 |
fdd(idat) = fdat (idat) |
fdd(idat) = fdat (idat) |
85 |
ENDDO |
ENDDO |
86 |
|
|
90 |
ENDDO |
ENDDO |
91 |
IF (xxd(i) < xxd(i-1)) THEN |
IF (xxd(i) < xxd(i-1)) THEN |
92 |
ichang = i |
ichang = i |
93 |
! *** reorganisation des longitudes entre 0. et 360. degres **** |
! *** reorganisation des longitudes entre 0. et 360. degres **** |
94 |
nid = idatmax - ichang +1 |
nid = idatmax - ichang +1 |
95 |
DO i = 1, nid |
DO i = 1, nid |
96 |
xchan (i) = xxd(i+ichang -1 ) |
xchan (i) = xxd(i+ichang -1) |
97 |
fdchan(i) = fdd(i+ichang -1 ) |
fdchan(i) = fdd(i+ichang -1) |
98 |
ENDDO |
ENDDO |
99 |
DO i=1, ichang -1 |
DO i=1, ichang -1 |
100 |
xchan (i+ nid) = xxd(i) |
xchan (i+ nid) = xxd(i) |
106 |
ENDDO |
ENDDO |
107 |
end IF |
end IF |
108 |
|
|
109 |
! translation des champs de donnees par rapport |
! translation des champs de donnees par rapport |
110 |
! a la nouvelle origine, avec redondance de la |
! a la nouvelle origine, avec redondance de la |
111 |
! maille a cheval sur les bords |
! maille a cheval sur les bords |
112 |
|
|
113 |
id0 = 0 |
id0 = 0 |
114 |
id1 = 0 |
id1 = 0 |
115 |
|
|
116 |
DO idat = 1, idatmax |
DO idat = 1, idatmax |
117 |
IF ( xxd( idatmax1- idat ).LT.360.) exit |
IF (xxd(idatmax1- idat) < 360.) exit |
118 |
id1 = id1 + 1 |
id1 = id1 + 1 |
119 |
ENDDO |
ENDDO |
120 |
|
|
121 |
DO idat = 1, idatmax |
DO idat = 1, idatmax |
122 |
IF (xxd(idat).GT.0.) exit |
IF (xxd(idat) > 0.) exit |
123 |
id0 = id0 + 1 |
id0 = id0 + 1 |
124 |
END DO |
END DO |
125 |
|
|
126 |
IF( id1 /= 0 ) then |
IF(id1 /= 0) then |
127 |
DO idat = 1, id1 |
DO idat = 1, id1 |
128 |
xxid(idat) = xxd(idatmax - id1 + idat) - 360. |
xxid(idat) = xxd(idatmax - id1 + idat) - 360. |
129 |
fxd (idat) = fdd(idatmax - id1 + idat) |
fxd (idat) = fdd(idatmax - id1 + idat) |
141 |
END DO |
END DO |
142 |
|
|
143 |
DO idat = 1, id0 |
DO idat = 1, id0 |
144 |
xxid (idatmax - id0 + idat) = xxd(idat) + 360. |
xxid (idatmax - id0 + idat) = xxd(idat) + 360. |
145 |
fxd (idatmax - id0 + idat) = fdd(idat) |
fxd (idatmax - id0 + idat) = fdd(idat) |
146 |
END DO |
END DO |
147 |
else |
else |
148 |
DO idat = 1, idatmax |
DO idat = 1, idatmax |
149 |
xxid(idat) = xxd(idat) |
xxid(idat) = xxd(idat) |
150 |
fxd (idat) = fdd(idat) |
fxd (idat) = fdd(idat) |
151 |
ENDDO |
ENDDO |
152 |
end IF |
end IF |
153 |
xxid(idatmax1) = xxid(1) + 360. |
xxid(idatmax1) = xxid(1) + 360. |
154 |
fxd (idatmax1) = fxd(1) |
fxd (idatmax1) = fxd(1) |
155 |
|
|
156 |
! initialisation du champ du modele |
! initialisation du champ du modele |
157 |
|
|
158 |
inter_barx(:) = 0. |
inter_barx(:) = 0. |
159 |
|
|
160 |
! iteration |
! iteration |
161 |
|
|
162 |
x0 = xim0 |
x0 = xim0 |
163 |
dxm = 0. |
dxm = 0. |
164 |
imod = 1 |
imod = 1 |
165 |
idat = 1 |
idat = 1 |
166 |
|
|
167 |
do while (imod <= imodmax) |
do while (imod <= imodmax) |
168 |
do while (xxim(imod).GT.xxid(idat)) |
do while (xxim(imod) > xxid(idat)) |
169 |
dx = xxid(idat) - x0 |
dx = xxid(idat) - x0 |
170 |
dxm = dxm + dx |
dxm = dxm + dx |
171 |
inter_barx(imod) = inter_barx(imod) + dx * fxd(idat) |
inter_barx(imod) = inter_barx(imod) + dx * fxd(idat) |
172 |
x0 = xxid(idat) |
x0 = xxid(idat) |
173 |
idat = idat + 1 |
idat = idat + 1 |
174 |
end do |
end do |
175 |
IF (xxim(imod).LT.xxid(idat)) THEN |
IF (xxim(imod) < xxid(idat)) THEN |
176 |
dx = xxim(imod) - x0 |
dx = xxim(imod) - x0 |
177 |
dxm = dxm + dx |
dxm = dxm + dx |
178 |
inter_barx(imod) = (inter_barx(imod) + dx * fxd(idat)) / dxm |
inter_barx(imod) = (inter_barx(imod) + dx * fxd(idat)) / dxm |
179 |
x0 = xxim(imod) |
x0 = xxim(imod) |
180 |
dxm = 0. |
dxm = 0. |
181 |
imod = imod + 1 |
imod = imod + 1 |
182 |
ELSE |
ELSE |
183 |
dx = xxim(imod) - x0 |
dx = xxim(imod) - x0 |
184 |
dxm = dxm + dx |
dxm = dxm + dx |
185 |
inter_barx(imod) = (inter_barx(imod) + dx * fxd(idat)) / dxm |
inter_barx(imod) = (inter_barx(imod) + dx * fxd(idat)) / dxm |
186 |
x0 = xxim(imod) |
x0 = xxim(imod) |
187 |
dxm = 0. |
dxm = 0. |
188 |
imod = imod + 1 |
imod = imod + 1 |
189 |
idat = idat + 1 |
idat = idat + 1 |
190 |
END IF |
END IF |