source: trunk/SRC/Interpolation/compute_fromreg_imoms3_weigaddr.pro @ 101

Last change on this file since 101 was 101, checked in by pinsard, 18 years ago

start to modify headers of Interpolation *.pro files for better idldoc output

  • Property svn:executable set to *
File size: 16.5 KB
Line 
1;+
2;
3; @file_comments compute the weight and address neede to interpolate data from a
4;          "regular grid" to any grid using the imoms3 method
5;   
6; @categories interpolation
7PRO compute_fromreg_imoms3_weigaddr, alonin, alatin, olonin, olat, weig, addr $
8;
9;     @param alonin {in}{required} longitude of the input data
10;     @param alatin  {in}{required} latitude of the input data
11;     @param olonin {in}{required} longitude of the output data
12;     @param olat {in}{required} latitude of the output data
13;
14; @keyword /NONORTHERNLINE and /NOSOUTHERNLINE activate if you don't whant to take into
15;          account the northen/southern line of the input data when perfoming the
16;          interpolation.
17;
18; @returns
19;     weig, addr: 2D arrays, weig and addr are the weight and addresses used to
20;     perform the interpolation:
21;          dataout = total(weig*datain[addr], 1)
22;          dataout = reform(dataout, jpio, jpjo, /over)
23;
24; @restrictions
25;  -  the input grid must be a "regular/rectangular grid", defined as a grid for
26;     which each lontitudes lines have the same latitude and each latitudes columns
27;     have the same longitude.
28;  -  We supposed the data are located on a sphere, with a periodicity along
29;     the longitude.
30;  -  points located between the first/last 2 lines are interpolated
31;     using a imoms3 interpolation along the longitudinal direction and linear
32;     interpolation along the latitudinal direction
33;  -  points located out of the southern and northern boundaries are interpolated
34;     using a imoms3 interpolation only along the longitudinal direction.
35;
36; @history
37;  November 2005: Sebastien Masson (smasson\@lodyc.jussieu.fr)
38;  March 2006: works for rectangular grids
39;-
40;
41;----------------------------------------------------------
42;----------------------------------------------------------
43;
44PRO compute_fromreg_imoms3_weigaddr, alonin, alatin, olonin, olat, weig, addr $
45                                     , NONORTHERNLINE = nonorthernline, NOSOUTHERNLINE = nosouthernline
46;
47  compile_opt strictarr, strictarrsubs
48;
49  alon = alonin
50  alat = alatin
51  olon = olonin
52;
53  jpia = n_elements(alon)
54  jpja = n_elements(alat)
55;
56  jpio = (size(olon, /dimensions))[0]
57  jpjo = (size(olon, /dimensions))[1]
58;
59; alon
60  minalon = min(alon,  max = maxalon)
61  IF maxalon-minalon GE 360. THEN stop
62; alon must be monotonically increasing
63  IF array_equal(sort(alon), lindgen(jpia)) NE 1 THEN BEGIN
64    shiftx = -(where(alon EQ min(alon)))[0]
65    alon = shift(alon, shiftx)
66    IF array_equal(sort(alon), lindgen(jpia)) NE 1 THEN stop
67  ENDIF ELSE shiftx = 0
68; alon is it regularly spaced?
69  step = alon-shift(alon, 1)
70  step[0] = step[0] + 360.
71  IF total((step-step[0]) GE 1.e-6) NE 0 THEN noregx = 1
72; we extend the longitude range of alon (-> easy interpolation even
73; near minalon et maxalon)
74  toadd = 10*jpia/360+1
75  alon = [alon[jpia-toadd:jpia-1]-360., alon[*], alon[0:toadd-1]+360.]
76  jpia = jpia+2*toadd
77; alat
78  revy = alat[0] GT alat[1]
79  IF revy THEN alat = reverse(alat)
80; alat must be monotonically increasing
81  IF array_equal(sort(alat), lindgen(jpja)) NE 1 THEN stop
82; alat is it regularly spaced?
83  step = alat-shift(alat, 1)
84  step = step[1:jpja - 1L]
85  IF total((step-step[0]) GE 1.e-6) NE 0 THEN noregy = 1
86;
87  if keyword_set(nonorthernline) then BEGIN
88    jpja = jpja - 1L
89    alat = alat[0: jpja-1L]
90  ENDIF
91  if keyword_set(nosouthernline) then BEGIN
92    alat = alat[1: jpja-1L]
93    jpja = jpja - 1L
94  ENDIF
95; olon between minalon et minalon+360
96  out = where(olon LT minalon)
97  WHILE out[0] NE -1 DO BEGIN
98    olon[out] = olon[out]+360.
99    out = where(olon LT minalon)
100  ENDWHILE
101  out = where(olon GE minalon+360.)
102  WHILE out[0] NE -1 DO BEGIN
103    olon[out] = olon[out]- 360.
104    out = where(olon GE minalon+360.)
105  ENDWHILE
106; make sure that all values of olon are located within values of alon
107  IF min(olon, max = ma) LT minalon THEN stop
108  IF ma GE minalon+360. THEN stop
109;
110  xaddr = lonarr(16, jpio*jpjo)
111  yaddr = lonarr(16, jpio*jpjo)
112  weig = fltarr(16, jpio*jpjo)
113;
114  indexlon = value_locate(alon, olon)
115  IF total(alon[indexlon] GT olon) NE 0 THEN stop
116  IF total(alon[indexlon + 1L] LE olon) NE 0 THEN stop
117  IF (where(indexlon LE 1L     ))[0] NE -1 THEN stop
118  IF (where(indexlon GE jpia-3L))[0] NE -1 THEN stop
119  indexlat = value_locate(alat, olat)
120;
121; for the ocean points located below the atm line
122; jpja-2 and above the line 1
123; for those points we can always find 16 neighbors
124; imoms interpolation along longitude and latitude
125;
126  short = where(indexlat LT jpja-2L AND indexlat GE 1L)
127  ilon = indexlon[short]
128  ilat = indexlat[short]
129;
130  IF NOT keyword_set(noregy) THEN BEGIN
131    delta = alat[ilat+1L]-alat[ilat]
132    IF max(abs(delta-delta[0])) GE 1.e-6 THEN stop
133    delta = delta[0]
134;
135    d0 = (alat[ilat-1L]-olat[short])/delta
136    IF min(d0, max = ma) LE -2 THEN stop
137    IF ma GT -1 THEN stop
138    wy0 = imoms3(temporary(d0))
139    d1 = (alat[ilat   ]-olat[short])/delta
140    IF min(d1, max = ma) LE -1 THEN stop
141    IF ma GT 0 THEN stop
142    wy1 = imoms3(temporary(d1))
143    d2 = (alat[ilat+1L]-olat[short])/delta
144    IF min(d2, max = ma) LE 0 THEN stop
145    IF ma GT 1 THEN stop 
146    wy2 = imoms3(temporary(d2))
147    d3 = (alat[ilat+2L]-olat[short])/delta
148    IF min(d3, max = ma) LE 1 THEN stop
149    IF ma GT 2 THEN stop 
150    wy3 = imoms3(temporary(d3))
151  ENDIF ELSE BEGIN
152    nele = n_elements(short)
153    wy0 = fltarr(nele)
154    wy1 = fltarr(nele)
155    wy2 = fltarr(nele)
156    wy3 = fltarr(nele)
157    FOR i = 0L, nele-1 DO BEGIN
158      IF i MOD 10000 EQ 0 THEN print, i
159      newlat = spl_incr(alat[ilat[i]-1L:ilat[i]+2L], [-1., 0., 1., 2.], olat[short[i]])
160      IF newlat LE 0 THEN stop
161      IF newlat GT 1 THEN stop
162      wy0[i] = imoms3(newlat+1)
163      wy1[i] = imoms3(newlat)
164      wy2[i] = imoms3(1-newlat)
165      wy3[i] = imoms3(2-newlat)
166    ENDFOR
167  ENDELSE
168;
169  mi = min(wy0+wy1+wy2+wy3, max = ma)
170  IF abs(mi-1) GE 1.e-6 THEN stop
171  IF abs(ma-1) GE 1.e-6 THEN stop
172;
173  IF NOT keyword_set(noregx) THEN BEGIN
174    delta = alon[ilon]-alon[ilon-1L]
175    IF max(abs(delta-delta[0])) GE 1.e-6 THEN stop
176    delta = delta[0]
177;
178    d0 = (alon[ilon-1L]-olon[short])/delta
179    IF min(d0, max = ma) LE -2 THEN stop
180    IF ma GT -1 THEN stop
181    wx0 = imoms3(temporary(d0))
182    d1 = (alon[ilon   ]-olon[short])/delta
183    IF min(d1, max = ma) LE -1 THEN stop
184    IF ma GT 0 THEN stop
185    wx1 = imoms3(temporary(d1))
186    d2 = (alon[ilon+1L]-olon[short])/delta
187    IF min(d2, max = ma) LE 0 THEN stop
188    IF ma GT 1 THEN stop
189    wx2 = imoms3(temporary(d2))
190    d3 = (alon[ilon+2L]-olon[short])/delta
191    IF min(d3, max = ma) LE 1 THEN stop
192    IF ma GT 2 THEN stop 
193    wx3 = imoms3(temporary(d3))
194  ENDIF ELSE BEGIN
195    nele = n_elements(short)
196    wx0 = fltarr(nele)
197    wx1 = fltarr(nele)
198    wx2 = fltarr(nele)
199    wx3 = fltarr(nele)
200    FOR i = 0L, nele-1 DO BEGIN
201      IF i MOD 10000 EQ 0 THEN print, i
202      newlon = spl_incr(alon[ilon[i]-1L:ilon[i]+2L], [-1., 0., 1., 2.], olon[short[i]])
203      IF newlon LE 0 THEN stop
204      IF newlon GT 1 THEN stop
205      wx0[i] = imoms3(newlon+1)
206      wx1[i] = imoms3(newlon)
207      wx2[i] = imoms3(1-newlon)
208      wx3[i] = imoms3(2-newlon)
209    ENDFOR
210  ENDELSE
211;
212  mi = min(wx0+wx1+wx2+wx3, max = ma)
213  IF abs(mi-1) GE 1.e-6 THEN stop
214  IF abs(ma-1) GE 1.e-6 THEN stop
215;
216; line 0
217  xaddr[0, short] = ilon - 1L
218  xaddr[1, short] = ilon 
219  xaddr[2, short] = ilon + 1L
220  xaddr[3, short] = ilon + 2L
221  yaddr[0, short] = ilat - 1L
222  yaddr[1, short] = yaddr[0, short]
223  yaddr[2, short] = yaddr[0, short]
224  yaddr[3, short] = yaddr[0, short]
225  weig[0, short] = wx0 * wy0
226  weig[1, short] = wx1 * wy0
227  weig[2, short] = wx2 * wy0
228  weig[3, short] = wx3 * wy0
229; line 1
230  xaddr[4, short] = ilon - 1L
231  xaddr[5, short] = ilon 
232  xaddr[6, short] = ilon + 1L
233  xaddr[7, short] = ilon + 2L
234  yaddr[4, short] = ilat 
235  yaddr[5, short] = ilat 
236  yaddr[6, short] = ilat 
237  yaddr[7, short] = ilat 
238  weig[4, short] = wx0 * wy1
239  weig[5, short] = wx1 * wy1
240  weig[6, short] = wx2 * wy1
241  weig[7, short] = wx3 * wy1
242; line 2
243  xaddr[8, short] = ilon - 1L
244  xaddr[9, short] = ilon 
245  xaddr[10, short] = ilon + 1L
246  xaddr[11, short] = ilon + 2L
247  yaddr[8, short] = ilat + 1L
248  yaddr[9, short] = yaddr[8, short]
249  yaddr[10, short] = yaddr[8, short]
250  yaddr[11, short] = yaddr[8, short]
251  weig[8, short] = wx0 * wy2
252  weig[9, short] = wx1 * wy2
253  weig[10, short] = wx2 * wy2
254  weig[11, short] = wx3 * wy2
255; line 3
256  xaddr[12, short] = ilon - 1L
257  xaddr[13, short] = ilon 
258  xaddr[14, short] = ilon + 1L
259  xaddr[15, short] = ilon + 2L
260  yaddr[12, short] = ilat + 2L
261  yaddr[13, short] = yaddr[12, short]
262  yaddr[14, short] = yaddr[12, short]
263  yaddr[15, short] = yaddr[12, short]
264  weig[12, short] = wx0 * wy3
265  weig[13, short] = wx1 * wy3
266  weig[14, short] = wx2 * wy3
267  weig[15, short] = wx3 * wy3
268;
269  mi = min(total(weig[*, short], 1), max = ma)
270  IF abs(mi-1) GE 1.e-6 THEN stop
271  IF abs(ma-1) GE 1.e-6 THEN stop
272;
273; for the ocean points located between the atm lines
274; jpja-2 and jpja-1 or between the atm lines 0 and 1
275; linear interpolation between line 1 and line 2
276;
277  short = where(indexlat EQ jpja-2L OR indexlat EQ 0)
278  IF short[0] NE -1 THEN BEGIN
279    ilon = indexlon[short]
280    ilat = indexlat[short]
281;
282    delta = alat[ilat+1L]-alat[ilat]
283    IF NOT keyword_set(noregy) THEN BEGIN
284      IF max(abs(delta-delta[0])) GE 1.e-6 THEN stop
285      delta = delta[0]
286    ENDIF
287;
288    d1 = (alat[ilat   ]-olat[short])/delta
289    IF min(d1, max = ma) LE -1 THEN stop
290    IF ma GT 0 THEN stop
291    wy1 = 1.+ temporary(d1)
292    d2 = (alat[ilat+1L]-olat[short])/delta
293    IF min(d2, max = ma) LE 0 THEN stop
294    IF ma GT 1 THEN stop 
295    wy2 = 1.- temporary(d2)
296;
297    mi = min(wy1+wy2, max = ma)
298    IF abs(mi-1) GE 1.e-6 THEN stop
299    IF abs(ma-1) GE 1.e-6 THEN stop
300; but imoms3 along the longitude
301    IF NOT keyword_set(noregx) THEN BEGIN
302      delta = alon[ilon]-alon[ilon-1L]
303      IF max(abs(delta-delta[0])) GE 1.e-6 THEN stop
304      delta = delta[0]
305;
306      d0 = (alon[ilon-1L]-olon[short])/delta
307      IF min(d0, max = ma) LE -2 THEN stop
308      IF ma GT -1 THEN stop
309      wx0 = imoms3(temporary(d0))
310      d1 = (alon[ilon   ]-olon[short])/delta
311      IF min(d1, max = ma) LE -1 THEN stop
312      IF ma GT 0 THEN stop
313      wx1 = imoms3(temporary(d1))
314      d2 = (alon[ilon+1L]-olon[short])/delta
315      IF min(d2, max = ma) LE 0 THEN stop
316      IF ma GT 1 THEN stop
317      wx2 = imoms3(temporary(d2))
318      d3 = (alon[ilon+2L]-olon[short])/delta
319      IF min(d3, max = ma) LE 1 THEN stop
320      IF ma GT 2 THEN stop 
321      wx3 = imoms3(temporary(d3))
322    ENDIF ELSE BEGIN
323      nele = n_elements(short)
324      wx0 = fltarr(nele)
325      wx1 = fltarr(nele)
326      wx2 = fltarr(nele)
327      wx3 = fltarr(nele)
328      FOR i = 0L, nele-1 DO BEGIN
329        IF i MOD 10000 EQ 0 THEN print, i
330        newlon = spl_incr(alon[ilon[i]-1L:ilon[i]+2L], [-1., 0., 1., 2.], olon[short[i]])
331        IF newlon LE 0 THEN stop
332        IF newlon GT 1 THEN stop
333        wx0[i] = imoms3(newlon+1)
334        wx1[i] = imoms3(newlon)
335        wx2[i] = imoms3(1-newlon)
336        wx3[i] = imoms3(2-newlon)
337      ENDFOR
338    ENDELSE
339;
340    mi = min(wx0+wx1+wx2+wx3, max = ma)
341    IF abs(mi-1) GE 1.e-6 THEN stop
342    IF abs(ma-1) GE 1.e-6 THEN stop
343; line 1
344    xaddr[0, short] = ilon - 1L
345    xaddr[1, short] = ilon 
346    xaddr[2, short] = ilon + 1L
347    xaddr[3, short] = ilon + 2L
348    yaddr[0, short] = ilat 
349    yaddr[1, short] = ilat 
350    yaddr[2, short] = ilat 
351    yaddr[3, short] = ilat 
352    weig[0, short] = wx0 * wy1
353    weig[1, short] = wx1 * wy1
354    weig[2, short] = wx2 * wy1
355    weig[3, short] = wx3 * wy1
356; line 2
357    xaddr[4, short] = ilon - 1L
358    xaddr[5, short] = ilon 
359    xaddr[6, short] = ilon + 1L
360    xaddr[7, short] = ilon + 2L
361    yaddr[4, short] = ilat + 1L
362    yaddr[5, short] = yaddr[4, short]
363    yaddr[6, short] = yaddr[4, short]
364    yaddr[7, short] = yaddr[4, short]
365    weig[4, short] = wx0 * wy2
366    weig[5, short] = wx1 * wy2
367    weig[6, short] = wx2 * wy2
368    weig[7, short] = wx3 * wy2
369;
370    mi = min(total(weig[*, short], 1), max = ma)
371    IF abs(mi-1) GE 1.e-6 THEN stop
372    IF abs(ma-1) GE 1.e-6 THEN stop
373;
374  ENDIF
375;
376; for the ocean points located below the line 0
377; Interpolation only along the longitude
378;
379  short = where(indexlat EQ -1)
380  IF short[0] NE -1 THEN BEGIN
381    ilon = indexlon[short]
382;
383    IF NOT keyword_set(noregx) THEN BEGIN
384      delta = alon[ilon]-alon[ilon-1L]
385      IF max(abs(delta-delta[0])) GE 1.e-6 THEN stop
386      delta = delta[0]
387;
388      d0 = (alon[ilon-1L]-olon[short])/delta
389      IF min(d0, max = ma) LE -2 THEN stop
390      IF ma GT -1 THEN stop
391      wx0 = imoms3(temporary(d0))
392      d1 = (alon[ilon   ]-olon[short])/delta
393      IF min(d1, max = ma) LE -1 THEN stop
394      IF ma GT 0 THEN stop
395      wx1 = imoms3(temporary(d1))
396      d2 = (alon[ilon+1L]-olon[short])/delta
397      IF min(d2, max = ma) LE 0 THEN stop
398      IF ma GT 1 THEN stop
399      wx2 = imoms3(temporary(d2))
400      d3 = (alon[ilon+2L]-olon[short])/delta
401      IF min(d3, max = ma) LE 1 THEN stop
402      IF ma GT 2 THEN stop 
403      wx3 = imoms3(temporary(d3))
404    ENDIF ELSE BEGIN
405      nele = n_elements(short)
406      wx0 = fltarr(nele)
407      wx1 = fltarr(nele)
408      wx2 = fltarr(nele)
409      wx3 = fltarr(nele)
410      FOR i = 0L, nele-1 DO BEGIN
411        IF i MOD 10000 EQ 0 THEN print, i
412        newlon = spl_incr(alon[ilon[i]-1L:ilon[i]+2L], [-1., 0., 1., 2.], olon[short[i]])
413        IF newlon LE 0 THEN stop
414        IF newlon GT 1 THEN stop
415        wx0[i] = imoms3(newlon+1)
416        wx1[i] = imoms3(newlon)
417        wx2[i] = imoms3(1-newlon)
418        wx3[i] = imoms3(2-newlon)
419      ENDFOR
420    ENDELSE
421;
422    mi = min(wx0+wx1+wx2+wx3, max = ma)
423    IF abs(mi-1) GE 1.e-6 THEN stop
424    IF abs(ma-1) GE 1.e-6 THEN stop
425; line 1
426    xaddr[0, short] = ilon - 1L
427    xaddr[1, short] = ilon 
428    xaddr[2, short] = ilon + 1L
429    xaddr[3, short] = ilon + 2L
430    yaddr[0:3, short] = 0
431    weig[0, short] = wx0
432    weig[1, short] = wx1
433    weig[2, short] = wx2
434    weig[3, short] = wx3
435;
436    mi = min(total(weig[*, short], 1), max = ma)
437    IF abs(mi-1) GE 1.e-6 THEN stop
438    IF abs(ma-1) GE 1.e-6 THEN stop
439;
440  ENDIF
441;
442; for the ocean points located above jpia-1
443; Interpolation only along the longitude
444;
445  short = where(indexlat EQ jpja-1L)
446  IF short[0] NE -1 THEN BEGIN
447    ilon = indexlon[short]
448;
449    IF NOT keyword_set(noregx) THEN BEGIN
450      delta = alon[ilon]-alon[ilon-1L]
451      IF max(abs(delta-delta[0])) GE 1.e-6 THEN stop
452      delta = delta[0]
453;
454      d0 = (alon[ilon-1L]-olon[short])/delta
455      IF min(d0, max = ma) LE -2 THEN stop
456      IF ma GT -1 THEN stop
457      wx0 = imoms3(temporary(d0))
458      d1 = (alon[ilon   ]-olon[short])/delta
459      IF min(d1, max = ma) LE -1 THEN stop
460      IF ma GT 0 THEN stop
461      wx1 = imoms3(temporary(d1))
462      d2 = (alon[ilon+1L]-olon[short])/delta
463      IF min(d2, max = ma) LE 0 THEN stop
464      IF ma GT 1 THEN stop
465      wx2 = imoms3(temporary(d2))
466      d3 = (alon[ilon+2L]-olon[short])/delta
467      IF min(d3, max = ma) LE 1 THEN stop
468      IF ma GT 2 THEN stop 
469      wx3 = imoms3(temporary(d3))
470    ENDIF ELSE BEGIN
471      nele = n_elements(short)
472      wx0 = fltarr(nele)
473      wx1 = fltarr(nele)
474      wx2 = fltarr(nele)
475      wx3 = fltarr(nele)
476      FOR i = 0L, nele-1 DO BEGIN
477        IF i MOD 10000 EQ 0 THEN print, i
478        newlon = spl_incr(alon[ilon[i]-1L:ilon[i]+2L], [-1., 0., 1., 2.], olon[short[i]])
479        IF newlon LE 0 THEN stop
480        IF newlon GT 1 THEN stop
481        wx0[i] = imoms3(newlon+1)
482        wx1[i] = imoms3(newlon)
483        wx2[i] = imoms3(1-newlon)
484        wx3[i] = imoms3(2-newlon)
485      ENDFOR
486    ENDELSE
487;
488    mi = min(wx0+wx1+wx2+wx3, max = ma)
489    IF abs(mi-1) GE 1.e-6 THEN stop
490    IF abs(ma-1) GE 1.e-6 THEN stop
491; line 1
492    xaddr[0, short] = ilon-1L
493    xaddr[1, short] = ilon 
494    xaddr[2, short] = ilon+1L
495    xaddr[3, short] = ilon+2L
496    yaddr[0:3, short] = jpja-1L
497    weig[0, short] = wx0
498    weig[1, short] = wx1
499    weig[2, short] = wx2
500    weig[3, short] = wx3
501;
502    mi = min(total(weig[*, short], 1), max = ma)
503    IF abs(mi-1) GE 1.e-6 THEN stop
504    IF abs(ma-1) GE 1.e-6 THEN stop
505;
506  ENDIF
507;
508; Come back to the original index of atm grid without longitudinal overlap.
509;
510;
511  xaddr = temporary(xaddr) - toadd
512  jpia = jpia - 2*toadd
513; make sure all values are ge 0
514  xaddr = temporary(xaddr) + jpia
515; range the values between 0 and jpia-1
516  xaddr = temporary(xaddr) mod jpia
517;
518; take into account shiftx if needed
519  IF shiftx NE 0 THEN xaddr = (temporary(xaddr) - shiftx) MOD jpia
520; take into account nosouthernline and nonorthernline
521  if keyword_set(nosouthernline) then BEGIN
522    yaddr = temporary(yaddr) + 1L
523    jpja = jpja + 1L
524  ENDIF
525  if keyword_set(nonorthernline) then jpja = jpja + 1L
526; take into account revy if needed
527  IF revy EQ 1 THEN yaddr = jpja - 1L - temporary(yaddr)
528;                        ;
529  addr = temporary(yaddr)*jpia+temporary(xaddr)
530;
531  RETURN
532END
Note: See TracBrowser for help on using the repository browser.