V3FIT
ezspline_interp.f90
1 !/////
2 ! R8 !
3 !/////
4 
5 !!!
6 !!! 1-d
7 !!!
8 
9 subroutine ezspline_interp1_r8(spline_o, p1, f, ier)
10  use ezspline_obj
11  implicit none
12  type(EZspline1_r8) spline_o
13  real(ezspline_r8) p1 ! the location where the interpolation is sought
14  real(ezspline_r8) f ! the interpolation
15  integer, intent(out) :: ier
16 
17  integer ifail
18  integer, parameter :: ict(3)=(/1, 0, 0/)
19  real(ezspline_r8) ansr(1)
20 
21  ier = 0
22  ifail = 0
23  if( .not.ezspline_allocated(spline_o) .or. spline_o%isReady /= 1) then
24  ier =94
25  return
26  endif
27 
28  if (spline_o%isLinear == 1) then
29 
30  call r8pc1ev(p1, &
31  & spline_o%x1(1), spline_o%n1, &
32  & spline_o%ilin1, &
33  & spline_o%fspl(1,1), &
34  & ict, ansr, ifail)
35 
36  else if (spline_o%isHermite == 0) then
37 
38  call r8evspline(p1, &
39  & spline_o%x1(1), spline_o%n1, &
40  & spline_o%ilin1, &
41  & spline_o%fspl(1,1), &
42  & ict, ansr, ifail)
43 
44  else
45 
46  call r8herm1ev(p1, &
47  & spline_o%x1(1), spline_o%n1, &
48  & spline_o%ilin1,&
49  & spline_o%fspl(1,1), &
50  & ict, ansr, ifail)
51 
52  endif
53 
54  f=ansr(1)
55 
56  if(ifail /= 0) ier = 97
57 
58 end subroutine ezspline_interp1_r8
59 
60 
61 subroutine ezspline_interp1_array_r8(spline_o, k, p1, f, ier)
62  use ezspline_obj
63  implicit none
64  type(EZspline1_r8) spline_o
65  integer, intent(in) :: k
66  real(ezspline_r8), intent(in) :: p1(k) ! location arrays
67  real(ezspline_r8), intent(out):: f(k) ! interpolant array
68  integer, intent(out) :: ier
69 
70  integer :: i, ifail
71  integer, parameter :: ict(3)=(/1,0,0/)
72  integer:: iwarn=0
73 
74  ier = 0
75  ifail = 0
76  if( .not.ezspline_allocated(spline_o) .or. spline_o%isReady /= 1) then
77  ier = 94
78  return
79  endif
80 
81  if (spline_o%isLinear == 1) then
82 
83  call r8vecpc1(ict, k, p1, k, f, &
84  & spline_o%n1,spline_o%x1pkg(1,1), &
85  & spline_o%fspl(1,1), &
86  & iwarn, ifail)
87 
88  else if (spline_o%isHermite == 0) then
89 
90  call r8vecspline(ict, k, p1, k, f, &
91  & spline_o%n1,spline_o%x1pkg(1,1), &
92  & spline_o%fspl(1,1), &
93  & iwarn, ifail)
94 
95  else
96 
97  call r8vecherm1(ict, k, p1, k, f, &
98  & spline_o%n1, spline_o%x1pkg(1,1), &
99  & spline_o%fspl(1,1), &
100  & iwarn,ifail)
101 
102  endif
103 
104  if(ifail /= 0) ier = 97
105 
106 end subroutine ezspline_interp1_array_r8
107 
108 !!!
109 !!! 2-d
110 !!!
111 
112 subroutine ezspline_interp2_r8(spline_o, p1, p2, f, ier)
113  use ezspline_obj
114  implicit none
115  type(EZspline2_r8) spline_o
116  real(ezspline_r8) p1, p2 ! the location where the interpolation is sought
117  real(ezspline_r8) f ! the interpolation
118  integer, intent(out) :: ier
119  integer ifail
120  integer, parameter :: ict(6)=(/1, 0, 0, 0, 0, 0 /)
121  real(ezspline_r8) ansr(1)
122 
123  ier = 0
124  ifail = 0
125  if( .not.ezspline_allocated(spline_o) .or. spline_o%isReady /= 1) then
126  ier =94
127  return
128  endif
129 
130  if (spline_o%isHybrid == 1) then
131 
132  call r8evintrp2d(p1, p2, &
133  & spline_o%x1(1), spline_o%n1, &
134  & spline_o%x2(1), spline_o%n2, &
135  & spline_o%hspline, spline_o%fspl(1,1,1), &
136  & size(spline_o%fspl,1), size(spline_o%fspl,2), &
137  & size(spline_o%fspl,3), &
138  & ict, ansr, ifail)
139 
140  else if (spline_o%isLinear == 1) then
141 
142  call r8pc2ev(p1, p2, &
143  & spline_o%x1(1), spline_o%n1, &
144  & spline_o%x2(1), spline_o%n2, &
145  & spline_o%ilin1, spline_o%ilin2, &
146  & spline_o%fspl(1,1,1), spline_o%n1, &
147  & ict, ansr, ifail)
148 
149  else if (spline_o%isHermite == 0) then
150 
151  call r8evbicub(p1, p2, &
152  & spline_o%x1(1), spline_o%n1, &
153  & spline_o%x2(1), spline_o%n2, &
154  & spline_o%ilin1, spline_o%ilin2, &
155  & spline_o%fspl(1,1,1), spline_o%n1, &
156  & ict, ansr, ifail)
157 
158  else
159 
160  call r8herm2ev(p1, p2, &
161  & spline_o%x1(1), spline_o%n1, &
162  & spline_o%x2(1), spline_o%n2, &
163  & spline_o%ilin1, spline_o%ilin2, &
164  & spline_o%fspl(1,1,1), spline_o%n1, &
165  & ict, ansr, ifail)
166 
167  endif
168 
169  f=ansr(1)
170 
171  if(ifail /= 0) ier = 97
172 
173 end subroutine ezspline_interp2_r8
174 
175 subroutine ezspline_interp2_array_r8(spline_o, k1, k2, p1, p2, f, ier)
176  use ezspline_obj
177  implicit none
178  type(EZspline2_r8) spline_o
179  integer, intent(in) :: k1, k2
180  real(ezspline_r8) :: p1(k1), p2(k2) ! location arrays
181  real(ezspline_r8) :: f(k1,k2) ! interpolated function array
182  integer, intent(out) :: ier
183 
184  integer ifail
185  integer:: iwarn=0
186 
187  ier = 0
188  ifail = 0
189  if( .not.ezspline_allocated(spline_o) .or. spline_o%isReady /= 1) then
190  ier =94
191  return
192  endif
193 
194  if (spline_o%isHybrid == 1) then
195 
196  call r8gridintrp2d( &
197  & p1, k1, &
198  & p2, k2, &
199  & f, k1, &
200  & spline_o%n1, spline_o%x1pkg(1,1), &
201  & spline_o%n2, spline_o%x2pkg(1,1), &
202  & spline_o%hspline, spline_o%fspl(1,1,1), &
203  & size(spline_o%fspl,1), size(spline_o%fspl,2), &
204  & size(spline_o%fspl,3), &
205  & iwarn, ifail)
206 
207  else if (spline_o%isLinear == 1) then
208 
209  call r8gridpc2( &
210  & p1, k1, &
211  & p2, k2, &
212  & f, k1, &
213  & spline_o%n1, spline_o%x1pkg(1,1), &
214  & spline_o%n2, spline_o%x2pkg(1,1), &
215  & spline_o%fspl(1,1,1), spline_o%n1, &
216  & iwarn, ifail)
217 
218  else if (spline_o%isHermite == 0) then
219 
220  call r8gridbicub( &
221  & p1, k1, &
222  & p2, k2, &
223  & f, k1, &
224  & spline_o%n1, spline_o%x1pkg(1,1), &
225  & spline_o%n2, spline_o%x2pkg(1,1), &
226  & spline_o%fspl(1,1,1), spline_o%n1, &
227  & iwarn, ifail)
228 
229  else
230 
231  call r8gridherm2( &
232  & p1, k1, &
233  & p2, k2, &
234  & f, k1, &
235  & spline_o%n1, spline_o%x1pkg(1,1), &
236  & spline_o%n2, spline_o%x2pkg(1,1), &
237  & spline_o%fspl(1,1,1), spline_o%n1, &
238  & iwarn, ifail)
239 
240  endif
241 
242  if(ifail /= 0) ier = 97
243 
244 end subroutine ezspline_interp2_array_r8
245 
246 subroutine ezspline_interp2_cloud_r8(spline_o, k, p1, p2, f, ier)
247  ! list of coordinate doublets
248  use ezspline_obj
249  implicit none
250  type(EZspline2_r8) spline_o
251  integer, intent(in) :: k
252  real(ezspline_r8), intent(in) :: p1(k), p2(k) ! location arrays
253  real(ezspline_r8), intent(out):: f(k) ! interpolant array
254  integer, intent(out) :: ier
255  integer :: ifail
256  integer, parameter :: ict(6) = (/1,0,0,0,0,0/)
257  integer:: iwarn = 0
258 
259  ier = 0
260  ifail = 0
261 
262  if( .not.ezspline_allocated(spline_o) .or. spline_o%isReady /= 1) then
263  ier = 94
264  return
265  endif
266 
267 
268  if (spline_o%isHybrid == 1) then
269 
270  call r8vecintrp2d(ict, k, p1, p2, k, f, &
271  & spline_o%n1, spline_o%x1pkg(1,1), &
272  & spline_o%n2, spline_o%x2pkg(1,1), &
273  & spline_o%hspline, spline_o%fspl(1,1,1), &
274  & size(spline_o%fspl,1), size(spline_o%fspl,2), &
275  & size(spline_o%fspl,3), &
276  & iwarn, ifail)
277 
278  else if (spline_o%isLinear == 1) then
279 
280  call r8vecpc2(ict, k, p1, p2, k, f, &
281  & spline_o%n1, spline_o%x1pkg(1,1), &
282  & spline_o%n2, spline_o%x2pkg(1,1), &
283  & spline_o%fspl(1,1,1), spline_o%n1, &
284  & iwarn, ifail)
285 
286  else if (spline_o%isHermite == 0) then
287  !
288  call r8vecbicub(ict, k, p1, p2, k, f, &
289  & spline_o%n1, spline_o%x1pkg(1,1), &
290  & spline_o%n2, spline_o%x2pkg(1,1), &
291  & spline_o%fspl(1,1,1), spline_o%n1, &
292  & iwarn, ifail)
293 
294  else
295 
296  call r8vecherm2(ict, k, p1, p2, k, f, &
297  & spline_o%n1, spline_o%x1pkg(1,1), &
298  & spline_o%n2, spline_o%x2pkg(1,1), &
299  & spline_o%fspl(1,1,1), spline_o%n1, &
300  & iwarn, ifail)
301 
302  endif
303 
304  if(ifail /= 0) ier = 97
305 
306 end subroutine ezspline_interp2_cloud_r8
307 
308 
309 !!!
310 !!! 3-d
311 !!!
312 
313 subroutine ezspline_interp3_r8(spline_o, p1, p2, p3, f, ier)
314  use ezspline_obj
315  implicit none
316  type(EZspline3_r8) spline_o
317  real(ezspline_r8) p1, p2, p3 ! the location where the interpolation is sought
318  real(ezspline_r8) f ! the interpolation
319 
320  integer, intent(out) :: ier
321  integer ifail
322  integer, parameter :: ict(10)=(/1,0,0,0,0,0,0,0,0,0/)
323  real(ezspline_r8) ansr(1)
324 
325  ier = 0
326  ifail=0
327  if( .not.ezspline_allocated(spline_o) .or. spline_o%isReady /= 1) then
328  ier =94
329  return
330  endif
331 
332  if (spline_o%isHybrid == 1) then
333 
334  call r8evintrp3d(p1, p2, p3, &
335  & spline_o%x1(1), spline_o%n1, &
336  & spline_o%x2(1), spline_o%n2, &
337  & spline_o%x3(1), spline_o%n3, &
338  & spline_o%hspline, spline_o%fspl(1,1,1,1), &
339  & size(spline_o%fspl,1), size(spline_o%fspl,2), &
340  & size(spline_o%fspl,3), size(spline_o%fspl,4), &
341  & ict, ansr, ifail)
342 
343  else if (spline_o%isLinear == 1) then
344 
345  call r8pc3ev(p1, p2, p3, &
346  & spline_o%x1(1), spline_o%n1, &
347  & spline_o%x2(1), spline_o%n2, &
348  & spline_o%x3(1), spline_o%n3, &
349  & spline_o%ilin1, spline_o%ilin2, spline_o%ilin3, &
350  & spline_o%fspl(1,1,1,1), spline_o%n1, spline_o%n2, &
351  & ict, ansr, ifail)
352 
353  else if (spline_o%isHermite == 0) then
354 
355  call r8evtricub(p1, p2, p3, &
356  & spline_o%x1(1), spline_o%n1, &
357  & spline_o%x2(1), spline_o%n2, &
358  & spline_o%x3(1), spline_o%n3, &
359  & spline_o%ilin1, spline_o%ilin2, spline_o%ilin3, &
360  & spline_o%fspl(1,1,1,1), spline_o%n1, spline_o%n2, &
361  & ict, ansr, ifail)
362 
363  else
364 
365  call r8herm3ev(p1, p2, p3, &
366  & spline_o%x1(1), spline_o%n1, &
367  & spline_o%x2(1), spline_o%n2, &
368  & spline_o%x3(1), spline_o%n3, &
369  & spline_o%ilin1, spline_o%ilin2, spline_o%ilin3, &
370  & spline_o%fspl(1,1,1,1), spline_o%n1, spline_o%n2, &
371  & ict, ansr, ifail)
372 
373  endif
374 
375  f=ansr(1)
376 
377  if(ifail /= 0) ier = 97
378 
379 end subroutine ezspline_interp3_r8
380 
381 subroutine ezspline_interp3_array_r8(spline_o, k1, k2, k3, p1, p2, p3, f, ier)
382  use ezspline_obj
383  implicit none
384  type(EZspline3_r8) spline_o
385  integer :: k1, k2, k3
386  real(ezspline_r8) :: p1(k1), p2(k2), p3(k3) ! location arrays
387  real(ezspline_r8) :: f(k1,k2,k3) ! interpolant array
388  integer, intent(out) :: ier
389 
390  integer ifail
391  integer:: iwarn=0
392 
393  ier = 0
394  ifail=0
395  if( .not.ezspline_allocated(spline_o) .or. spline_o%isReady /= 1) then
396  ier =94
397  return
398  endif
399 
400  if (spline_o%isHybrid == 1) then
401 
402  call r8gridintrp3d( &
403  & p1, k1, &
404  & p2, k2, &
405  & p3, k3, &
406  & f, k1, k2, &
407  & spline_o%n1, spline_o%x1pkg(1,1), &
408  & spline_o%n2, spline_o%x2pkg(1,1), &
409  & spline_o%n3, spline_o%x3pkg(1,1), &
410  & spline_o%hspline, spline_o%fspl(1,1,1,1), &
411  & size(spline_o%fspl,1), size(spline_o%fspl,2), &
412  & size(spline_o%fspl,3), size(spline_o%fspl,4), &
413  & iwarn, ifail)
414 
415  else if (spline_o%isLinear == 1) then
416 
417  call r8gridpc3( &
418  & p1, k1, &
419  & p2, k2, &
420  & p3, k3, &
421  & f, k1, k2, &
422  & spline_o%n1, spline_o%x1pkg(1,1), &
423  & spline_o%n2, spline_o%x2pkg(1,1), &
424  & spline_o%n3, spline_o%x3pkg(1,1), &
425  & spline_o%fspl(1,1,1,1), spline_o%n1, spline_o%n2, &
426  & iwarn, ifail)
427 
428  else if (spline_o%isHermite == 0) then
429  !
430  call r8gridtricub( &
431  & p1, k1, &
432  & p2, k2, &
433  & p3, k3, &
434  & f, k1, k2, &
435  & spline_o%n1, spline_o%x1pkg(1,1), &
436  & spline_o%n2, spline_o%x2pkg(1,1), &
437  & spline_o%n3, spline_o%x3pkg(1,1), &
438  & spline_o%fspl(1,1,1,1), spline_o%n1, spline_o%n2, &
439  & iwarn,ifail)
440 
441  else
442 
443  call r8gridherm3( &
444  & p1, k1, &
445  & p2, k2, &
446  & p3, k3, &
447  & f, k1, k2, &
448  & spline_o%n1, spline_o%x1pkg(1,1), &
449  & spline_o%n2, spline_o%x2pkg(1,1), &
450  & spline_o%n3, spline_o%x3pkg(1,1), &
451  & spline_o%fspl(1,1,1,1), spline_o%n1, spline_o%n2, &
452  & iwarn, ifail)
453 
454  endif
455 
456  if(ifail /= 0) ier = 97
457 
458 end subroutine ezspline_interp3_array_r8
459 
460 subroutine ezspline_interp3_cloud_r8(spline_o, k, p1, p2, p3, f, ier)
461  ! list of coordinate triplets
462  use ezspline_obj
463  implicit none
464  type(EZspline3_r8) spline_o
465  integer, intent(in) :: k
466  real(ezspline_r8), intent(in) :: p1(k), p2(k), p3(k) ! location arrays
467  real(ezspline_r8), intent(out):: f(k) ! interpolant array
468  integer, intent(out) :: ier
469 
470  integer :: ifail
471  integer, parameter :: ict(10)=(/1,0,0,0,0,0,0,0,0,0/)
472  integer:: iwarn=0
473 
474  ier = 0
475  ifail=0
476  if( .not.ezspline_allocated(spline_o) .or. spline_o%isReady /= 1) then
477  ier = 94
478  return
479  endif
480 
481  if (spline_o%isHybrid == 1) then
482 
483  call r8vecintrp3d(ict, k, p1, p2, p3, k, f, &
484  & spline_o%n1, spline_o%x1pkg(1,1), &
485  & spline_o%n2, spline_o%x2pkg(1,1), &
486  & spline_o%n3, spline_o%x3pkg(1,1), &
487  & spline_o%hspline, spline_o%fspl(1,1,1,1), &
488  & size(spline_o%fspl,1), size(spline_o%fspl,2), &
489  & size(spline_o%fspl,3), size(spline_o%fspl,4), &
490  & iwarn, ifail)
491 
492  else if (spline_o%isLinear == 1) then
493 
494  call r8vecpc3(ict, k, p1, p2, p3, k, f, &
495  & spline_o%n1, spline_o%x1pkg(1,1), &
496  & spline_o%n2, spline_o%x2pkg(1,1), &
497  & spline_o%n3, spline_o%x3pkg(1,1), &
498  & spline_o%fspl(1,1,1,1), spline_o%n1, spline_o%n2, &
499  & iwarn,ifail)
500 
501  else if (spline_o%isHermite == 0) then
502  !
503  call r8vectricub(ict, k, p1, p2, p3, k, f, &
504  & spline_o%n1,spline_o%x1pkg(1,1), &
505  & spline_o%n2,spline_o%x2pkg(1,1), &
506  & spline_o%n3,spline_o%x3pkg(1,1), &
507  & spline_o%fspl(1,1,1,1), spline_o%n1, spline_o%n2, &
508  & iwarn, ifail)
509 
510  else
511 
512  call r8vecherm3(ict, k, p1, p2, p3, k, f, &
513  & spline_o%n1, spline_o%x1pkg(1,1), &
514  & spline_o%n2, spline_o%x2pkg(1,1), &
515  & spline_o%n3, spline_o%x3pkg(1,1), &
516  & spline_o%fspl(1,1,1,1), spline_o%n1, spline_o%n2, &
517  & iwarn,ifail)
518 
519  endif
520 
521  if(ifail /= 0) ier = 97
522 
523 end subroutine ezspline_interp3_cloud_r8
524 !/////
525 ! R4 !
526 !/////
527 
528 !!!
529 !!! 1-d
530 !!!
531 
532 subroutine ezspline_interp1_r4(spline_o, p1, f, ier)
533  use ezspline_obj
534  implicit none
535  type(EZspline1_r4) spline_o
536  real(ezspline_r4) p1 ! the location where the interpolation is sought
537  real(ezspline_r4) f ! the interpolation
538  integer, intent(out) :: ier
539 
540  integer ifail
541  integer, parameter :: ict(3)=(/1, 0, 0/)
542  real(ezspline_r4) ansr(1)
543 
544  ier = 0
545  ifail = 0
546  if( .not.ezspline_allocated(spline_o) .or. spline_o%isReady /= 1) then
547  ier =94
548  return
549  endif
550 
551  if (spline_o%isLinear == 1) then
552 
553  call pc1ev(p1, &
554  & spline_o%x1(1), spline_o%n1, &
555  & spline_o%ilin1,&
556  & spline_o%fspl(1,1), &
557  & ict, ansr, ifail)
558 
559  else if (spline_o%isHermite == 0) then
560 
561  call evspline(p1, &
562  & spline_o%x1(1), spline_o%n1, &
563  & spline_o%ilin1, &
564  & spline_o%fspl(1,1), &
565  & ict, ansr, ifail)
566 
567  else
568 
569  call herm1ev(p1, &
570  & spline_o%x1(1), spline_o%n1, &
571  & spline_o%ilin1,&
572  & spline_o%fspl(1,1), &
573  & ict, ansr, ifail)
574 
575  endif
576 
577  f=ansr(1)
578 
579  if(ifail /= 0) ier = 97
580 
581 end subroutine ezspline_interp1_r4
582 
583 
584 subroutine ezspline_interp1_array_r4(spline_o, k, p1, f, ier)
585  use ezspline_obj
586  implicit none
587  type(EZspline1_r4) spline_o
588  integer, intent(in) :: k
589  real(ezspline_r4), intent(in) :: p1(k) ! location arrays
590  real(ezspline_r4), intent(out):: f(k) ! interpolant array
591  integer, intent(out) :: ier
592 
593  integer :: i, ifail
594  integer, parameter :: ict(3)=(/1,0,0/)
595  integer:: iwarn=0
596 
597  ier = 0
598  ifail = 0
599  if( .not.ezspline_allocated(spline_o) .or. spline_o%isReady /= 1) then
600  ier = 94
601  return
602  endif
603 
604  if (spline_o%isLinear == 1) then
605 
606  call vecpc1(ict, k, p1, k, f, &
607  & spline_o%n1, spline_o%x1pkg(1,1), &
608  & spline_o%fspl(1,1), &
609  & iwarn,ifail)
610 
611  else if (spline_o%isHermite == 0) then
612 
613  call vecspline(ict, k, p1, k, f, &
614  & spline_o%n1,spline_o%x1pkg(1,1), &
615  & spline_o%fspl(1,1), &
616  & iwarn, ifail)
617 
618  else
619 
620  call vecherm1(ict, k, p1, k, f, &
621  & spline_o%n1, spline_o%x1pkg(1,1), &
622  & spline_o%fspl(1,1), &
623  & iwarn,ifail)
624 
625  endif
626 
627  if(ifail /= 0) ier = 97
628 
629 end subroutine ezspline_interp1_array_r4
630 
631 !!!
632 !!! 2-d
633 !!!
634 
635 subroutine ezspline_interp2_r4(spline_o, p1, p2, f, ier)
636  use ezspline_obj
637  implicit none
638  type(EZspline2_r4) spline_o
639  real(ezspline_r4) p1, p2 ! the location where the interpolation is sought
640  real(ezspline_r4) f ! the interpolation
641  integer, intent(out) :: ier
642  integer ifail
643  integer, parameter :: ict(6)=(/1, 0, 0, 0, 0, 0 /)
644  real(ezspline_r4) ansr(1)
645 
646  ier = 0
647  ifail = 0
648  if( .not.ezspline_allocated(spline_o) .or. spline_o%isReady /= 1) then
649  ier =94
650  return
651  endif
652 
653  if (spline_o%isHybrid == 1) then
654 
655  call evintrp2d(p1, p2, &
656  & spline_o%x1(1), spline_o%n1, &
657  & spline_o%x2(1), spline_o%n2, &
658  & spline_o%hspline, spline_o%fspl(1,1,1), &
659  & size(spline_o%fspl,1), size(spline_o%fspl,2), &
660  & size(spline_o%fspl,3), &
661  & ict, ansr, ifail)
662 
663  else if (spline_o%isLinear == 1) then
664 
665  call pc2ev(p1, p2, &
666  & spline_o%x1(1), spline_o%n1, &
667  & spline_o%x2(1), spline_o%n2, &
668  & spline_o%ilin1, spline_o%ilin2, &
669  & spline_o%fspl(1,1,1), spline_o%n1, &
670  & ict, ansr, ifail)
671 
672  else if (spline_o%isHermite == 0) then
673  call evbicub(p1, p2, &
674  & spline_o%x1(1), spline_o%n1, &
675  & spline_o%x2(1), spline_o%n2, &
676  & spline_o%ilin1, spline_o%ilin2, &
677  & spline_o%fspl(1,1,1), spline_o%n1, &
678  & ict, ansr, ifail)
679 
680  else
681 
682  call herm2ev(p1, p2, &
683  & spline_o%x1(1), spline_o%n1, &
684  & spline_o%x2(1), spline_o%n2, &
685  & spline_o%ilin1, spline_o%ilin2, &
686  & spline_o%fspl(1,1,1), spline_o%n1, &
687  & ict, ansr, ifail)
688 
689  endif
690 
691  f=ansr(1)
692 
693  if(ifail /= 0) ier = 97
694 
695 end subroutine ezspline_interp2_r4
696 
697 subroutine ezspline_interp2_array_r4(spline_o, k1, k2, p1, p2, f, ier)
698  use ezspline_obj
699  implicit none
700  type(EZspline2_r4) spline_o
701  integer, intent(in) :: k1, k2
702  real(ezspline_r4) :: p1(k1), p2(k2) ! location arrays
703  real(ezspline_r4) :: f(k1,k2) ! interpolated function array
704  integer, intent(out) :: ier
705 
706  integer ifail
707  integer:: iwarn=0
708 
709  ier = 0
710  ifail = 0
711  if( .not.ezspline_allocated(spline_o) .or. spline_o%isReady /= 1) then
712  ier =94
713  return
714  endif
715 
716  if (spline_o%isHybrid == 1) then
717 
718  call gridintrp2d( &
719  & p1, k1, &
720  & p2, k2, &
721  & f, k1, &
722  & spline_o%n1, spline_o%x1pkg(1,1), &
723  & spline_o%n2, spline_o%x2pkg(1,1), &
724  & spline_o%hspline, spline_o%fspl(1,1,1), &
725  & size(spline_o%fspl,1), size(spline_o%fspl,2), &
726  & size(spline_o%fspl,3), &
727  & iwarn, ifail)
728 
729  else if (spline_o%isLinear == 1) then
730 
731  call gridpc2( &
732  & p1, k1, &
733  & p2, k2, &
734  & f, k1, &
735  & spline_o%n1, spline_o%x1pkg(1,1), &
736  & spline_o%n2, spline_o%x2pkg(1,1), &
737  & spline_o%fspl(1,1,1), spline_o%n1, &
738  & iwarn, ifail)
739 
740  else if (spline_o%isHermite == 0) then
741 
742  call gridbicub( &
743  & p1, k1, &
744  & p2, k2, &
745  & f, k1, &
746  & spline_o%n1, spline_o%x1pkg(1,1), &
747  & spline_o%n2, spline_o%x2pkg(1,1), &
748  & spline_o%fspl(1,1,1), spline_o%n1, &
749  & iwarn, ifail)
750 
751  else
752 
753  call gridherm2( &
754  & p1, k1, &
755  & p2, k2, &
756  & f, k1, &
757  & spline_o%n1, spline_o%x1pkg(1,1), &
758  & spline_o%n2, spline_o%x2pkg(1,1), &
759  & spline_o%fspl(1,1,1), spline_o%n1, &
760  & iwarn, ifail)
761 
762  endif
763 
764  if(ifail /= 0) ier = 97
765 
766 
767 end subroutine ezspline_interp2_array_r4
768 
769 subroutine ezspline_interp2_cloud_r4(spline_o, k, p1, p2, f, ier)
770  ! list of coordinate doublets
771  use ezspline_obj
772  implicit none
773  type(EZspline2_r4) spline_o
774  integer, intent(in) :: k
775  real(ezspline_r4), intent(in) :: p1(k), p2(k) ! location arrays
776  real(ezspline_r4), intent(out):: f(k) ! interpolant array
777  integer, intent(out) :: ier
778  integer :: ifail
779  integer, parameter :: ict(6) = (/1,0,0,0,0,0/)
780  integer:: iwarn = 0
781 
782  ier = 0
783  ifail = 0
784 
785  if( .not.ezspline_allocated(spline_o) .or. spline_o%isReady /= 1) then
786  ier = 94
787  return
788  endif
789 
790 
791  if (spline_o%isHybrid == 1) then
792 
793  call vecintrp2d(ict, k, p1, p2, k, f, &
794  & spline_o%n1, spline_o%x1pkg(1,1), &
795  & spline_o%n2, spline_o%x2pkg(1,1), &
796  & spline_o%hspline, spline_o%fspl(1,1,1), &
797  & size(spline_o%fspl,1), size(spline_o%fspl,2), &
798  & size(spline_o%fspl,3), &
799  & iwarn, ifail)
800 
801  else if (spline_o%isLinear == 1) then
802 
803  call vecpc2(ict, k, p1, p2, k, f, &
804  & spline_o%n1, spline_o%x1pkg(1,1), &
805  & spline_o%n2, spline_o%x2pkg(1,1), &
806  & spline_o%fspl(1,1,1), spline_o%n1, &
807  & iwarn, ifail)
808 
809  else if (spline_o%isHermite == 0) then
810  !
811  call vecbicub(ict, k, p1, p2, k, f, &
812  & spline_o%n1, spline_o%x1pkg(1,1), &
813  & spline_o%n2, spline_o%x2pkg(1,1), &
814  & spline_o%fspl(1,1,1), spline_o%n1, &
815  & iwarn, ifail)
816 
817  else
818 
819  call vecherm2(ict, k, p1, p2, k, f, &
820  & spline_o%n1, spline_o%x1pkg(1,1), &
821  & spline_o%n2, spline_o%x2pkg(1,1), &
822  & spline_o%fspl(1,1,1), spline_o%n1, &
823  & iwarn, ifail)
824 
825  endif
826 
827  if(ifail /= 0) ier = 97
828 
829 end subroutine ezspline_interp2_cloud_r4
830 
831 
832 !!!
833 !!! 3-d
834 !!!
835 
836 subroutine ezspline_interp3_r4(spline_o, p1, p2, p3, f, ier)
837  use ezspline_obj
838  implicit none
839  type(EZspline3_r4) spline_o
840  real(ezspline_r4) p1, p2, p3 ! the location where the interpolation is sought
841  real(ezspline_r4) f ! the interpolation
842 
843  integer, intent(out) :: ier
844  integer ifail
845  integer, parameter :: ict(10)=(/1,0,0,0,0,0,0,0,0,0/)
846  real(ezspline_r4) ansr(1)
847 
848  ier = 0
849  ifail=0
850  if( .not.ezspline_allocated(spline_o) .or. spline_o%isReady /= 1) then
851  ier =94
852  return
853  endif
854 
855  if (spline_o%isHybrid == 1) then
856 
857  call evintrp3d(p1, p2, p3, &
858  & spline_o%x1(1), spline_o%n1, &
859  & spline_o%x2(1), spline_o%n2, &
860  & spline_o%x3(1), spline_o%n3, &
861  & spline_o%hspline, spline_o%fspl(1,1,1,1), &
862  & size(spline_o%fspl,1), size(spline_o%fspl,2), &
863  & size(spline_o%fspl,3), size(spline_o%fspl,4), &
864  & ict, ansr, ifail)
865 
866  else if (spline_o%isLinear == 1) then
867 
868  call pc3ev(p1, p2, p3, &
869  & spline_o%x1(1), spline_o%n1, &
870  & spline_o%x2(1), spline_o%n2, &
871  & spline_o%x3(1), spline_o%n3, &
872  & spline_o%ilin1, spline_o%ilin2, spline_o%ilin3, &
873  & spline_o%fspl(1,1,1,1), spline_o%n1, spline_o%n2, &
874  & ict, ansr, ifail)
875 
876  else if (spline_o%isHermite == 0) then
877 
878  call evtricub(p1, p2, p3, &
879  & spline_o%x1(1), spline_o%n1, &
880  & spline_o%x2(1), spline_o%n2, &
881  & spline_o%x3(1), spline_o%n3, &
882  & spline_o%ilin1, spline_o%ilin2, spline_o%ilin3, &
883  & spline_o%fspl(1,1,1,1), spline_o%n1, spline_o%n2, &
884  & ict, ansr, ifail)
885 
886  else
887 
888  call herm3ev(p1, p2, p3, &
889  & spline_o%x1(1), spline_o%n1, &
890  & spline_o%x2(1), spline_o%n2, &
891  & spline_o%x3(1), spline_o%n3, &
892  & spline_o%ilin1, spline_o%ilin2, spline_o%ilin3, &
893  & spline_o%fspl(1,1,1,1), spline_o%n1, spline_o%n2, &
894  & ict, ansr, ifail)
895 
896  endif
897 
898  f=ansr(1)
899 
900  if(ifail /= 0) ier = 97
901 
902 end subroutine ezspline_interp3_r4
903 
904 subroutine ezspline_interp3_array_r4(spline_o, k1, k2, k3, p1, p2, p3, f, ier)
905  use ezspline_obj
906  implicit none
907  type(EZspline3_r4) spline_o
908  integer :: k1, k2, k3
909  real(ezspline_r4) :: p1(k1), p2(k2), p3(k3) ! location arrays
910  real(ezspline_r4) :: f(k1,k2,k3) ! interpolant array
911  integer, intent(out) :: ier
912 
913  integer ifail
914  integer:: iwarn=0
915 
916  ier = 0
917  ifail=0
918  if( .not.ezspline_allocated(spline_o) .or. spline_o%isReady /= 1) then
919  ier =94
920  return
921  endif
922 
923  if (spline_o%isHybrid == 1) then
924 
925  call gridintrp3d( &
926  & p1, k1, &
927  & p2, k2, &
928  & p3, k3, &
929  & f, k1, k2, &
930  & spline_o%n1, spline_o%x1pkg(1,1), &
931  & spline_o%n2, spline_o%x2pkg(1,1), &
932  & spline_o%n3, spline_o%x3pkg(1,1), &
933  & spline_o%hspline, spline_o%fspl(1,1,1,1), &
934  & size(spline_o%fspl,1), size(spline_o%fspl,2), &
935  & size(spline_o%fspl,3), size(spline_o%fspl,4), &
936  & iwarn, ifail)
937 
938  else if (spline_o%isLinear == 1) then
939 
940  call gridpc3( &
941  & p1, k1, &
942  & p2, k2, &
943  & p3, k3, &
944  & f, k1, k2, &
945  & spline_o%n1, spline_o%x1pkg(1,1), &
946  & spline_o%n2, spline_o%x2pkg(1,1), &
947  & spline_o%n3, spline_o%x3pkg(1,1), &
948  & spline_o%fspl(1,1,1,1), spline_o%n1, spline_o%n2, &
949  & iwarn, ifail)
950 
951  else if (spline_o%isHermite == 0) then
952  !
953  call gridtricub( &
954  & p1, k1, &
955  & p2, k2, &
956  & p3, k3, &
957  & f, k1, k2, &
958  & spline_o%n1, spline_o%x1pkg(1,1), &
959  & spline_o%n2, spline_o%x2pkg(1,1), &
960  & spline_o%n3, spline_o%x3pkg(1,1), &
961  & spline_o%fspl(1,1,1,1), spline_o%n1, spline_o%n2, &
962  & iwarn,ifail)
963 
964  else
965 
966  call gridherm3( &
967  & p1, k1, &
968  & p2, k2, &
969  & p3, k3, &
970  & f, k1, k2, &
971  & spline_o%n1, spline_o%x1pkg(1,1), &
972  & spline_o%n2, spline_o%x2pkg(1,1), &
973  & spline_o%n3, spline_o%x3pkg(1,1), &
974  & spline_o%fspl(1,1,1,1), spline_o%n1, spline_o%n2, &
975  & iwarn, ifail)
976 
977  endif
978 
979  if(ifail /= 0) ier = 97
980 
981 end subroutine ezspline_interp3_array_r4
982 
983 subroutine ezspline_interp3_cloud_r4(spline_o, k, p1, p2, p3, f, ier)
984  ! list of coordinate triplets
985  use ezspline_obj
986  implicit none
987  type(EZspline3_r4) spline_o
988  integer, intent(in) :: k
989  real(ezspline_r4), intent(in) :: p1(k), p2(k), p3(k) ! location arrays
990  real(ezspline_r4), intent(out):: f(k) ! interpolant array
991  integer, intent(out) :: ier
992 
993  integer :: ifail
994  integer, parameter :: ict(10)=(/1,0,0,0,0,0,0,0,0,0/)
995  integer:: iwarn=0
996 
997  ier = 0
998  ifail=0
999  if( .not.ezspline_allocated(spline_o) .or. spline_o%isReady /= 1) then
1000  ier = 94
1001  return
1002  endif
1003 
1004  if (spline_o%isHybrid == 1) then
1005 
1006  call vecintrp3d(ict, k, p1, p2, p3, k, f, &
1007  & spline_o%n1, spline_o%x1pkg(1,1), &
1008  & spline_o%n2, spline_o%x2pkg(1,1), &
1009  & spline_o%n3, spline_o%x3pkg(1,1), &
1010  & spline_o%hspline, spline_o%fspl(1,1,1,1), &
1011  & size(spline_o%fspl,1), size(spline_o%fspl,2), &
1012  & size(spline_o%fspl,3), size(spline_o%fspl,4), &
1013  & iwarn, ifail)
1014 
1015  else if (spline_o%isLinear == 1) then
1016 
1017  call vecpc3(ict, k, p1, p2, p3, k, f, &
1018  & spline_o%n1, spline_o%x1pkg(1,1), &
1019  & spline_o%n2, spline_o%x2pkg(1,1), &
1020  & spline_o%n3, spline_o%x3pkg(1,1), &
1021  & spline_o%fspl(1,1,1,1), spline_o%n1, spline_o%n2, &
1022  & iwarn,ifail)
1023 
1024  else if (spline_o%isHermite == 0) then
1025  !
1026  call vectricub(ict, k, p1, p2, p3, k, f, &
1027  & spline_o%n1,spline_o%x1pkg(1,1), &
1028  & spline_o%n2,spline_o%x2pkg(1,1), &
1029  & spline_o%n3,spline_o%x3pkg(1,1), &
1030  & spline_o%fspl(1,1,1,1), spline_o%n1, spline_o%n2, &
1031  & iwarn, ifail)
1032 
1033  else
1034 
1035  call vecherm3(ict, k, p1, p2, p3, k, f, &
1036  & spline_o%n1, spline_o%x1pkg(1,1), &
1037  & spline_o%n2, spline_o%x2pkg(1,1), &
1038  & spline_o%n3, spline_o%x3pkg(1,1), &
1039  & spline_o%fspl(1,1,1,1), spline_o%n1, spline_o%n2, &
1040  & iwarn,ifail)
1041 
1042  endif
1043 
1044  if(ifail /= 0) ier = 97
1045 
1046 end subroutine ezspline_interp3_cloud_r4
ezspline_obj::ezspline_allocated
Definition: ezspline_obj.f90:19
Generated on Thu Mar 5 2020 15:49:24 for V3FIT by   doxygen 1.8.17