8 subroutine ezspline_gradient1_r8(spline_o, &
12 type(EZspline1_r8) spline_o
13 real(ezspline_r8),
intent(in) :: p1
14 real(ezspline_r8),
intent(out) :: df
15 integer,
intent(out) :: ier
18 integer,
parameter :: ict(3) = (/0, 1, 0/)
27 if(spline_o%isLinear == 1)
then
30 & spline_o%x1(1), spline_o%n1, &
32 & spline_o%fspl(1,1), &
35 else if(spline_o%isHermite == 0)
then
38 & spline_o%x1(1), spline_o%n1, &
40 & spline_o%fspl(1,1), &
46 & spline_o%x1(1), spline_o%n1, &
48 & spline_o%fspl(1,1), &
54 end subroutine ezspline_gradient1_r8
57 subroutine ezspline_gradient1_array_r8(spline_o, k1, &
61 type(EZspline1_r8) spline_o
62 integer,
intent(in) :: k1
63 real(ezspline_r8),
intent(in) :: p1(k1)
64 real(ezspline_r8),
intent(out) :: df(k1)
68 integer,
intent(out) :: ier
70 integer,
parameter :: ict(3) = (/0, 1, 0/)
80 if(spline_o%isLinear == 1)
then
82 call r8vecpc1(ict, k1, p1, k1, df, &
83 & spline_o%n1, spline_o%x1pkg(1,1), &
84 & spline_o%fspl(1,1), &
87 else if(spline_o%isHermite == 0)
then
89 call r8vecspline(ict, k1, p1, k1, df, &
90 & spline_o%n1,spline_o%x1pkg(1,1), &
91 & spline_o%fspl(1,1), &
97 call r8vecherm1(ict, k1, p1, k1, df, &
98 & spline_o%n1, spline_o%x1pkg(1,1), &
99 & spline_o%fspl(1,1), &
104 if(ifail /= 0) ier = 95
105 end subroutine ezspline_gradient1_array_r8
112 subroutine ezspline_gradient2_r8(spline_o, &
116 type(EZspline2_r8) spline_o
117 real(ezspline_r8),
intent(in) :: p1, p2
118 real(ezspline_r8),
intent(out) :: df(2)
120 integer,
intent(out) :: ier
122 integer,
parameter :: ict(6) = (/0, 1, 1, 0, 0, 0/)
131 if (spline_o%isHybrid == 1)
then
133 call r8evintrp2d(p1, p2, &
134 & spline_o%x1(1), spline_o%n1, &
135 & spline_o%x2(1), spline_o%n2, &
136 & spline_o%hspline, spline_o%fspl(1,1,1), &
137 &
size(spline_o%fspl,1),
size(spline_o%fspl,2), &
138 &
size(spline_o%fspl,3), &
141 else if(spline_o%isLinear == 1)
then
143 call r8pc2ev(p1, p2, &
144 & spline_o%x1(1), spline_o%n1, &
145 & spline_o%x2(1), spline_o%n2, &
146 & spline_o%ilin1, spline_o%ilin2, &
147 & spline_o%fspl(1,1,1), spline_o%n1, &
150 else if(spline_o%isHermite == 0)
then
152 call r8evbicub(p1, p2, &
153 & spline_o%x1(1), spline_o%n1, &
154 & spline_o%x2(1), spline_o%n2, &
155 & spline_o%ilin1, spline_o%ilin2, &
156 & spline_o%fspl(1,1,1), spline_o%n1, &
161 call r8herm2ev(p1, p2, &
162 & spline_o%x1(1), spline_o%n1, &
163 & spline_o%x2(1), spline_o%n2, &
164 & spline_o%ilin1, spline_o%ilin2, &
165 & spline_o%fspl(1,1,1), spline_o%n1, &
169 if(ifail/=0) ier = 95
171 end subroutine ezspline_gradient2_r8
173 subroutine ezspline_gradient2_cloud_r8(spline_o, k, &
177 type(EZspline2_r8) spline_o
178 integer,
intent(in) :: k
179 real(ezspline_r8),
intent(in) :: p1(k), p2(k)
180 real(ezspline_r8),
intent(out) :: df(k,2)
182 integer,
intent(out) :: ier
184 integer,
parameter :: ict(6) = (/0, 1, 1, 0, 0, 0/)
194 if (spline_o%isHybrid == 1)
then
196 call r8vecintrp2d(ict, k, p1, p2, k, df, &
197 & spline_o%n1, spline_o%x1pkg(1,1), &
198 & spline_o%n2, spline_o%x2pkg(1,1), &
199 & spline_o%hspline, spline_o%fspl(1,1,1), &
200 &
size(spline_o%fspl,1),
size(spline_o%fspl,2), &
201 &
size(spline_o%fspl,3), &
204 else if(spline_o%isLinear == 1)
then
206 call r8vecpc2(ict, k, p1, p2, k, df, &
207 & spline_o%n1, spline_o%x1pkg(1,1), &
208 & spline_o%n2, spline_o%x2pkg(1,1), &
209 & spline_o%fspl(1,1,1), spline_o%n1, &
212 else if(spline_o%isHermite == 0)
then
214 call r8vecbicub(ict, k, p1, p2, k, df, &
215 & spline_o%n1,spline_o%x1pkg(1,1), &
216 & spline_o%n2,spline_o%x2pkg(1,1), &
217 & spline_o%fspl(1,1,1), spline_o%n1, &
222 call r8vecherm2(ict, k, p1, p2, k, df, &
223 & spline_o%n1, spline_o%x1pkg(1,1), &
224 & spline_o%n2, spline_o%x2pkg(1,1), &
225 & spline_o%fspl(1,1,1), spline_o%n1, &
229 if(ifail /= 0) ier = 95
231 end subroutine ezspline_gradient2_cloud_r8
234 subroutine ezspline_gradient2_array_r8(spline_o, k1, k2, &
238 type(EZspline2_r8) spline_o
239 integer,
intent(in) :: k1, k2
240 real(ezspline_r8),
intent(in) :: p1(k1), p2(k2)
241 real(ezspline_r8),
intent(out) :: df(k1, k2, 2)
243 integer,
intent(out) :: ier
245 integer,
parameter :: ict(6) = (/0, 1, 1, 0, 0, 0/)
247 real(ezspline_r8),
dimension(:),
allocatable :: p1_cloud, p2_cloud
259 allocate(p1_cloud(k12), p2_cloud(k12), stat=ifail)
265 p1_cloud = reshape( &
266 & source=spread(source=p1, dim=2, ncopies=k2), shape=(/k12/))
267 p2_cloud = reshape( &
268 & source=spread(source=p2, dim=1, ncopies=k1), shape=(/k12/))
270 if(spline_o%isHybrid == 1)
then
272 call r8vecintrp2d(ict, k12, p1_cloud, p2_cloud, k12, df, &
273 & spline_o%n1, spline_o%x1pkg(1,1), &
274 & spline_o%n2, spline_o%x2pkg(1,1), &
275 & spline_o%hspline, spline_o%fspl(1,1,1), &
276 &
size(spline_o%fspl,1),
size(spline_o%fspl,2), &
277 &
size(spline_o%fspl,3), &
280 else if(spline_o%isLinear == 1)
then
282 call r8vecpc2(ict, k12, p1_cloud, p2_cloud, k12, df, &
283 & spline_o%n1, spline_o%x1pkg(1,1), &
284 & spline_o%n2, spline_o%x2pkg(1,1), &
285 & spline_o%fspl(1,1,1), spline_o%n1, &
288 else if(spline_o%isHermite == 0)
then
290 call r8vecbicub(ict, k12, p1_cloud, p2_cloud, k12, df, &
291 & spline_o%n1,spline_o%x1pkg(1,1), &
292 & spline_o%n2,spline_o%x2pkg(1,1), &
293 & spline_o%fspl(1,1,1), spline_o%n1, &
298 call r8vecherm2(ict, k12, p1_cloud, p2_cloud, k12, df, &
299 & spline_o%n1, spline_o%x1pkg(1,1), &
300 & spline_o%n2, spline_o%x2pkg(1,1), &
301 & spline_o%fspl(1,1,1), spline_o%n1, &
306 deallocate(p1_cloud, p2_cloud, stat=ifail)
312 if(ifail /= 0) ier = 95
314 end subroutine ezspline_gradient2_array_r8
321 subroutine ezspline_gradient3_r8(spline_o, &
325 type(EZspline3_r8) spline_o
326 real(ezspline_r8),
intent(in) :: p1, p2, p3
327 real(ezspline_r8),
intent(out) :: df(3)
329 integer,
intent(out) :: ier
331 integer,
parameter :: ict(10) = (/0, 1, 1, 1, 0, 0, 0, 0, 0, 0/)
340 if (spline_o%isHybrid == 1)
then
342 call r8evintrp3d(p1, p2, p3, &
343 & spline_o%x1(1), spline_o%n1, &
344 & spline_o%x2(1), spline_o%n2, &
345 & spline_o%x3(1), spline_o%n3, &
346 & spline_o%hspline, spline_o%fspl(1,1,1,1), &
347 &
size(spline_o%fspl,1),
size(spline_o%fspl,2), &
348 &
size(spline_o%fspl,3),
size(spline_o%fspl,4), &
351 else if(spline_o%isLinear == 1)
then
353 call r8pc3ev(p1, p2, p3, &
354 & spline_o%x1(1), spline_o%n1, &
355 & spline_o%x2(1), spline_o%n2, &
356 & spline_o%x3(1), spline_o%n3, &
357 & spline_o%ilin1, spline_o%ilin2, spline_o%ilin3, &
358 & spline_o%fspl(1,1,1,1), spline_o%n1, spline_o%n2, &
361 else if(spline_o%isHermite == 0)
then
363 call r8evtricub(p1, p2, p3, &
364 & spline_o%x1(1), spline_o%n1, &
365 & spline_o%x2(1), spline_o%n2, &
366 & spline_o%x3(1), spline_o%n3, &
367 & spline_o%ilin1, spline_o%ilin2, spline_o%ilin3, &
368 & spline_o%fspl(1,1,1,1), spline_o%n1, spline_o%n2, &
373 call r8herm3ev(p1, p2, p3, &
374 & spline_o%x1(1), spline_o%n1, &
375 & spline_o%x2(1), spline_o%n2, &
376 & spline_o%x3(1), spline_o%n3, &
377 & spline_o%ilin1, spline_o%ilin2, spline_o%ilin3, &
378 & spline_o%fspl(1,1,1,1), spline_o%n1, spline_o%n2, &
383 if(ifail/=0) ier = 95
385 end subroutine ezspline_gradient3_r8
387 subroutine ezspline_gradient3_cloud_r8(spline_o, k, &
391 type(EZspline3_r8) spline_o
392 integer,
intent(in) :: k
393 real(ezspline_r8),
intent(in) :: p1(k), p2(k), p3(k)
394 real(ezspline_r8),
intent(out) :: df(k, 3)
396 integer,
intent(out) :: ier
398 integer,
parameter :: ict(10) = (/0, 1, 1, 1, 0, 0, 0, 0, 0, 0/)
407 if (spline_o%isHybrid == 1)
then
409 call r8vecintrp3d(ict, k, p1, p2, p3, k, df, &
410 & spline_o%n1, spline_o%x1pkg(1,1), &
411 & spline_o%n2, spline_o%x2pkg(1,1), &
412 & spline_o%n3, spline_o%x3pkg(1,1), &
413 & spline_o%hspline, spline_o%fspl(1,1,1,1), &
414 &
size(spline_o%fspl,1),
size(spline_o%fspl,2), &
415 &
size(spline_o%fspl,3),
size(spline_o%fspl,4), &
418 else if(spline_o%isLinear == 1)
then
420 call r8vecpc3(ict, k, p1, p2, p3, k, df, &
421 & spline_o%n1, spline_o%x1pkg(1,1), &
422 & spline_o%n2, spline_o%x2pkg(1,1), &
423 & spline_o%n3, spline_o%x3pkg(1,1), &
424 & spline_o%fspl(1,1,1,1), spline_o%n1, spline_o%n2, &
427 else if(spline_o%isHermite == 0)
then
429 call r8vectricub(ict, k, p1, p2, p3, k, df, &
430 & spline_o%n1,spline_o%x1pkg(1,1), &
431 & spline_o%n2,spline_o%x2pkg(1,1), &
432 & spline_o%n3,spline_o%x3pkg(1,1), &
433 & spline_o%fspl(1,1,1,1), spline_o%n1, spline_o%n2, &
438 call r8vecherm3(ict, k, p1, p2, p3, k, df, &
439 & spline_o%n1, spline_o%x1pkg(1,1), &
440 & spline_o%n2, spline_o%x2pkg(1,1), &
441 & spline_o%n3, spline_o%x3pkg(1,1), &
442 & spline_o%fspl(1,1,1,1), spline_o%n1, spline_o%n2, &
447 if(ifail /= 0) ier = 95
450 end subroutine ezspline_gradient3_cloud_r8
453 subroutine ezspline_gradient3_array_r8(spline_o, k1, k2, k3, &
457 type(EZspline3_r8) spline_o
458 integer,
intent(in) :: k1, k2, k3
459 real(ezspline_r8),
intent(in) :: p1(k1), p2(k2), p3(k3)
460 real(ezspline_r8),
intent(out) :: df(k1, k2, k3, 3)
462 integer,
intent(out) :: ier
464 integer,
parameter :: ict(10) = (/0, 1, 1, 1, 0, 0, 0, 0, 0, 0/)
466 real(ezspline_r8),
dimension(:),
allocatable :: p1_cloud, p2_cloud, p3_cloud
477 allocate(p1_cloud(k123), p2_cloud(k123), p3_cloud(k123), stat=ifail)
483 p1_cloud = reshape(source=spread( &
484 & source=spread(source=p1, dim=2, ncopies=k2), &
485 & dim=3, ncopies=k3), shape=(/k123/))
486 p2_cloud = reshape(source=spread( &
487 & source=spread(source=p2, dim=1, ncopies=k1), &
488 & dim=3, ncopies=k3), shape=(/k123/))
489 p3_cloud = reshape(source=spread( &
490 & source=spread(source=p3, dim=1, ncopies=k1), &
491 & dim=2, ncopies=k2), shape=(/k123/))
493 if (spline_o%isHybrid == 1)
then
495 call r8vecintrp3d(ict, k123, p1_cloud, p2_cloud, p3_cloud, k123, df, &
496 & spline_o%n1, spline_o%x1pkg(1,1), &
497 & spline_o%n2, spline_o%x2pkg(1,1), &
498 & spline_o%n3, spline_o%x3pkg(1,1), &
499 & spline_o%hspline, spline_o%fspl(1,1,1,1), &
500 &
size(spline_o%fspl,1),
size(spline_o%fspl,2), &
501 &
size(spline_o%fspl,3),
size(spline_o%fspl,4), &
504 else if(spline_o%isLinear == 1)
then
506 call r8vecpc3(ict, k123, p1_cloud, p2_cloud, p3_cloud, k123, df, &
507 & spline_o%n1, spline_o%x1pkg(1,1), &
508 & spline_o%n2, spline_o%x2pkg(1,1), &
509 & spline_o%n3, spline_o%x3pkg(1,1), &
510 & spline_o%fspl(1,1,1,1), spline_o%n1, spline_o%n2, &
513 else if(spline_o%isHermite == 0)
then
515 call r8vectricub(ict, k123, p1_cloud, p2_cloud, p3_cloud, k123, df, &
516 & spline_o%n1,spline_o%x1pkg(1,1), &
517 & spline_o%n2,spline_o%x2pkg(1,1), &
518 & spline_o%n3,spline_o%x3pkg(1,1), &
519 & spline_o%fspl(1,1,1,1), spline_o%n1, spline_o%n2, &
524 call r8vecherm3(ict, k123, p1_cloud, p2_cloud, p3_cloud, k123, df, &
525 & spline_o%n1, spline_o%x1pkg(1,1), &
526 & spline_o%n2, spline_o%x2pkg(1,1), &
527 & spline_o%n3, spline_o%x3pkg(1,1), &
528 & spline_o%fspl(1,1,1,1), spline_o%n1, spline_o%n2, &
533 if(ifail /= 0) ier = 95
535 deallocate(p1_cloud, p2_cloud, p3_cloud, stat=ifail)
541 end subroutine ezspline_gradient3_array_r8
550 subroutine ezspline_gradient1_r4(spline_o, &
554 type(EZspline1_r4) spline_o
555 real(ezspline_r4),
intent(in) :: p1
556 real(ezspline_r4),
intent(out) :: df
557 integer,
intent(out) :: ier
560 integer,
parameter :: ict(3) = (/0, 1, 0/)
569 if(spline_o%isLinear == 1)
then
572 & spline_o%x1(1), spline_o%n1, &
574 & spline_o%fspl(1,1), &
577 else if(spline_o%isHermite == 0)
then
580 & spline_o%x1(1), spline_o%n1, &
582 & spline_o%fspl(1,1), &
588 & spline_o%x1(1), spline_o%n1, &
590 & spline_o%fspl(1,1), &
594 if(ifail/=0) ier = 95
596 end subroutine ezspline_gradient1_r4
599 subroutine ezspline_gradient1_array_r4(spline_o, k1, &
603 type(EZspline1_r4) spline_o
604 integer,
intent(in) :: k1
605 real(ezspline_r4),
intent(in) :: p1(k1)
606 real(ezspline_r4),
intent(out) :: df(k1)
610 integer,
intent(out) :: ier
612 integer,
parameter :: ict(3) = (/0, 1, 0/)
622 if(spline_o%isLinear == 1)
then
624 call vecpc1(ict, k1, p1, k1, df, &
625 & spline_o%n1, spline_o%x1pkg(1,1), &
626 & spline_o%fspl(1,1), &
629 else if(spline_o%isHermite == 0)
then
631 call vecspline(ict, k1, p1, k1, df, &
632 & spline_o%n1,spline_o%x1pkg(1,1), &
633 & spline_o%fspl(1,1), &
639 call vecherm1(ict, k1, p1, k1, df, &
640 & spline_o%n1, spline_o%x1pkg(1,1), &
641 & spline_o%fspl(1,1), &
646 if(ifail /= 0) ier = 95
647 end subroutine ezspline_gradient1_array_r4
654 subroutine ezspline_gradient2_r4(spline_o, &
658 type(EZspline2_r4) spline_o
659 real(ezspline_r4),
intent(in) :: p1, p2
660 real(ezspline_r4),
intent(out) :: df(2)
662 integer,
intent(out) :: ier
664 integer,
parameter :: ict(6) = (/0, 1, 1, 0, 0, 0/)
673 if (spline_o%isHybrid == 1)
then
675 call evintrp2d(p1, p2, &
676 & spline_o%x1(1), spline_o%n1, &
677 & spline_o%x2(1), spline_o%n2, &
678 & spline_o%hspline, spline_o%fspl(1,1,1), &
679 &
size(spline_o%fspl,1),
size(spline_o%fspl,2), &
680 &
size(spline_o%fspl,3), &
683 else if(spline_o%isLinear == 1)
then
686 & spline_o%x1(1), spline_o%n1, &
687 & spline_o%x2(1), spline_o%n2, &
688 & spline_o%ilin1, spline_o%ilin2, &
689 & spline_o%fspl(1,1,1), spline_o%n1, &
692 else if(spline_o%isHermite == 0)
then
694 call evbicub(p1, p2, &
695 & spline_o%x1(1), spline_o%n1, &
696 & spline_o%x2(1), spline_o%n2, &
697 & spline_o%ilin1, spline_o%ilin2, &
698 & spline_o%fspl(1,1,1), spline_o%n1, &
703 call herm2ev(p1, p2, &
704 & spline_o%x1(1), spline_o%n1, &
705 & spline_o%x2(1), spline_o%n2, &
706 & spline_o%ilin1, spline_o%ilin2, &
707 & spline_o%fspl(1,1,1), spline_o%n1, &
712 if(ifail/=0) ier = 95
714 end subroutine ezspline_gradient2_r4
716 subroutine ezspline_gradient2_cloud_r4(spline_o, k, &
720 type(EZspline2_r4) spline_o
721 integer,
intent(in) :: k
722 real(ezspline_r4),
intent(in) :: p1(k), p2(k)
723 real(ezspline_r4),
intent(out) :: df(k,2)
725 integer,
intent(out) :: ier
727 integer,
parameter :: ict(6) = (/0, 1, 1, 0, 0, 0/)
738 if (spline_o%isHybrid == 1)
then
740 call vecintrp2d(ict, k, p1, p2, k, df, &
741 & spline_o%n1, spline_o%x1pkg(1,1), &
742 & spline_o%n2, spline_o%x2pkg(1,1), &
743 & spline_o%hspline, spline_o%fspl(1,1,1), &
744 &
size(spline_o%fspl,1),
size(spline_o%fspl,2), &
745 &
size(spline_o%fspl,3), &
748 else if(spline_o%isLinear == 1)
then
750 call vecpc2(ict, k, p1, p2, k, df, &
751 & spline_o%n1, spline_o%x1pkg(1,1), &
752 & spline_o%n2, spline_o%x2pkg(1,1), &
753 & spline_o%fspl(1,1,1), spline_o%n1, &
756 else if(spline_o%isHermite == 0)
then
758 call vecbicub(ict, k, p1, p2, k, df, &
759 & spline_o%n1,spline_o%x1pkg(1,1), &
760 & spline_o%n2,spline_o%x2pkg(1,1), &
761 & spline_o%fspl(1,1,1), spline_o%n1, &
767 call vecherm2(ict, k, p1, p2, k, df, &
768 & spline_o%n1, spline_o%x1pkg(1,1), &
769 & spline_o%n2, spline_o%x2pkg(1,1), &
770 & spline_o%fspl(1,1,1), spline_o%n1, &
774 if(ifail /= 0) ier = 95
776 end subroutine ezspline_gradient2_cloud_r4
779 subroutine ezspline_gradient2_array_r4(spline_o, k1, k2, &
783 type(EZspline2_r4) spline_o
784 integer,
intent(in) :: k1, k2
785 real(ezspline_r4),
intent(in) :: p1(k1), p2(k2)
786 real(ezspline_r4),
intent(out) :: df(k1, k2, 2)
788 integer,
intent(out) :: ier
790 integer,
parameter :: ict(6) = (/0, 1, 1, 0, 0, 0/)
792 real(ezspline_r4),
dimension(:),
allocatable :: p1_cloud, p2_cloud
804 allocate(p1_cloud(k12), p2_cloud(k12), stat=ifail)
810 p1_cloud = reshape( &
811 & source=spread(source=p1, dim=2, ncopies=k2), shape=(/k12/))
812 p2_cloud = reshape( &
813 & source=spread(source=p2, dim=1, ncopies=k1), shape=(/k12/))
815 if (spline_o%isHybrid == 1)
then
817 call vecintrp2d(ict, k12, p1_cloud, p2_cloud, k12, df, &
818 & spline_o%n1, spline_o%x1pkg(1,1), &
819 & spline_o%n2, spline_o%x2pkg(1,1), &
820 & spline_o%hspline, spline_o%fspl(1,1,1), &
821 &
size(spline_o%fspl,1),
size(spline_o%fspl,2), &
822 &
size(spline_o%fspl,3), &
825 else if(spline_o%isLinear == 1)
then
827 call vecpc2(ict, k12, p1_cloud, p2_cloud, k12, df, &
828 & spline_o%n1, spline_o%x1pkg(1,1), &
829 & spline_o%n2, spline_o%x2pkg(1,1), &
830 & spline_o%fspl(1,1,1), spline_o%n1, &
833 else if(spline_o%isHermite == 0)
then
835 call vecbicub(ict, k12, p1_cloud, p2_cloud, k12, df, &
836 & spline_o%n1,spline_o%x1pkg(1,1), &
837 & spline_o%n2,spline_o%x2pkg(1,1), &
838 & spline_o%fspl(1,1,1), spline_o%n1, &
843 call vecherm2(ict, k12, p1_cloud, p2_cloud, k12, df, &
844 & spline_o%n1, spline_o%x1pkg(1,1), &
845 & spline_o%n2, spline_o%x2pkg(1,1), &
846 & spline_o%fspl(1,1,1), spline_o%n1, &
851 deallocate(p1_cloud, p2_cloud, stat=ifail)
857 if(ifail /= 0) ier = 95
859 end subroutine ezspline_gradient2_array_r4
866 subroutine ezspline_gradient3_r4(spline_o, &
870 type(EZspline3_r4) spline_o
871 real(ezspline_r4),
intent(in) :: p1, p2, p3
872 real(ezspline_r4),
intent(out) :: df(3)
874 integer,
intent(out) :: ier
876 integer,
parameter :: ict(10) = (/0, 1, 1, 1, 0, 0, 0, 0, 0, 0/)
885 if (spline_o%isHybrid == 1)
then
887 call evintrp3d(p1, p2, p3, &
888 & spline_o%x1(1), spline_o%n1, &
889 & spline_o%x2(1), spline_o%n2, &
890 & spline_o%x3(1), spline_o%n3, &
891 & spline_o%hspline, spline_o%fspl(1,1,1,1), &
892 &
size(spline_o%fspl,1),
size(spline_o%fspl,2), &
893 &
size(spline_o%fspl,3),
size(spline_o%fspl,4), &
896 else if(spline_o%isLinear == 1)
then
898 call pc3ev(p1, p2, p3, &
899 & spline_o%x1(1), spline_o%n1, &
900 & spline_o%x2(1), spline_o%n2, &
901 & spline_o%x3(1), spline_o%n3, &
902 & spline_o%ilin1, spline_o%ilin2, spline_o%ilin3, &
903 & spline_o%fspl(1,1,1,1), spline_o%n1, spline_o%n2, &
906 else if(spline_o%isHermite == 0)
then
908 call evtricub(p1, p2, p3, &
909 & spline_o%x1(1), spline_o%n1, &
910 & spline_o%x2(1), spline_o%n2, &
911 & spline_o%x3(1), spline_o%n3, &
912 & spline_o%ilin1, spline_o%ilin2, spline_o%ilin3, &
913 & spline_o%fspl(1,1,1,1), spline_o%n1, spline_o%n2, &
918 call herm3ev(p1, p2, p3, &
919 & spline_o%x1(1), spline_o%n1, &
920 & spline_o%x2(1), spline_o%n2, &
921 & spline_o%x3(1), spline_o%n3, &
922 & spline_o%ilin1, spline_o%ilin2, spline_o%ilin3, &
923 & spline_o%fspl(1,1,1,1), spline_o%n1, spline_o%n2, &
928 if(ifail/=0) ier = 95
930 end subroutine ezspline_gradient3_r4
932 subroutine ezspline_gradient3_cloud_r4(spline_o, k, &
936 type(EZspline3_r4) spline_o
937 integer,
intent(in) :: k
938 real(ezspline_r4),
intent(in) :: p1(k), p2(k), p3(k)
939 real(ezspline_r4),
intent(out) :: df(k, 3)
941 integer,
intent(out) :: ier
943 integer,
parameter :: ict(10) = (/0, 1, 1, 1, 0, 0, 0, 0, 0, 0/)
952 if (spline_o%isHybrid == 1)
then
954 call vecintrp3d(ict, k, p1, p2, p3, k, df, &
955 & spline_o%n1, spline_o%x1pkg(1,1), &
956 & spline_o%n2, spline_o%x2pkg(1,1), &
957 & spline_o%n3, spline_o%x3pkg(1,1), &
958 & spline_o%hspline, spline_o%fspl(1,1,1,1), &
959 &
size(spline_o%fspl,1),
size(spline_o%fspl,2), &
960 &
size(spline_o%fspl,3),
size(spline_o%fspl,4), &
963 else if(spline_o%isLinear == 1)
then
965 call vecpc3(ict, k, p1, p2, p3, k, df, &
966 & spline_o%n1, spline_o%x1pkg(1,1), &
967 & spline_o%n2, spline_o%x2pkg(1,1), &
968 & spline_o%n3, spline_o%x3pkg(1,1), &
969 & spline_o%fspl(1,1,1,1), spline_o%n1, spline_o%n2, &
972 else if(spline_o%isHermite == 0)
then
974 call vectricub(ict, k, p1, p2, p3, k, df, &
975 & spline_o%n1,spline_o%x1pkg(1,1), &
976 & spline_o%n2,spline_o%x2pkg(1,1), &
977 & spline_o%n3,spline_o%x3pkg(1,1), &
978 & spline_o%fspl(1,1,1,1), spline_o%n1, spline_o%n2, &
983 call vecherm3(ict, k, p1, p2, p3, k, df, &
984 & spline_o%n1, spline_o%x1pkg(1,1), &
985 & spline_o%n2, spline_o%x2pkg(1,1), &
986 & spline_o%n3, spline_o%x3pkg(1,1), &
987 & spline_o%fspl(1,1,1,1), spline_o%n1, spline_o%n2, &
992 if(ifail /= 0) ier = 95
995 end subroutine ezspline_gradient3_cloud_r4
998 subroutine ezspline_gradient3_array_r4(spline_o, k1, k2, k3, &
1002 type(EZspline3_r4) spline_o
1003 integer,
intent(in) :: k1, k2, k3
1004 real(ezspline_r4),
intent(in) :: p1(k1), p2(k2), p3(k3)
1005 real(ezspline_r4),
intent(out) :: df(k1, k2, k3, 3)
1007 integer,
intent(out) :: ier
1009 integer,
parameter :: ict(10) = (/0, 1, 1, 1, 0, 0, 0, 0, 0, 0/)
1011 real(ezspline_r4),
dimension(:),
allocatable :: p1_cloud, p2_cloud, p3_cloud
1022 allocate(p1_cloud(k123), p2_cloud(k123), p3_cloud(k123), stat=ifail)
1028 p1_cloud = reshape(source=spread( &
1029 & source=spread(source=p1, dim=2, ncopies=k2), &
1030 & dim=3, ncopies=k3), shape=(/k123/))
1031 p2_cloud = reshape(source=spread( &
1032 & source=spread(source=p2, dim=1, ncopies=k1), &
1033 & dim=3, ncopies=k3), shape=(/k123/))
1034 p3_cloud = reshape(source=spread( &
1035 & source=spread(source=p3, dim=1, ncopies=k1), &
1036 & dim=2, ncopies=k2), shape=(/k123/))
1038 if (spline_o%isHybrid == 1)
then
1040 call vecintrp3d(ict, k123, p1_cloud, p2_cloud, p3_cloud, k123, df, &
1041 & spline_o%n1, spline_o%x1pkg(1,1), &
1042 & spline_o%n2, spline_o%x2pkg(1,1), &
1043 & spline_o%n3, spline_o%x3pkg(1,1), &
1044 & spline_o%hspline, spline_o%fspl(1,1,1,1), &
1045 &
size(spline_o%fspl,1),
size(spline_o%fspl,2), &
1046 &
size(spline_o%fspl,3),
size(spline_o%fspl,4), &
1049 else if(spline_o%isLinear == 1)
then
1051 call vecpc3(ict, k123, p1_cloud, p2_cloud, p3_cloud, k123, df, &
1052 & spline_o%n1, spline_o%x1pkg(1,1), &
1053 & spline_o%n2, spline_o%x2pkg(1,1), &
1054 & spline_o%n3, spline_o%x3pkg(1,1), &
1055 & spline_o%fspl(1,1,1,1), spline_o%n1, spline_o%n2, &
1058 else if(spline_o%isHermite == 0)
then
1060 call vectricub(ict, k123, p1_cloud, p2_cloud, p3_cloud, k123, df, &
1061 & spline_o%n1,spline_o%x1pkg(1,1), &
1062 & spline_o%n2,spline_o%x2pkg(1,1), &
1063 & spline_o%n3,spline_o%x3pkg(1,1), &
1064 & spline_o%fspl(1,1,1,1), spline_o%n1, spline_o%n2, &
1069 call vecherm3(ict, k123, p1_cloud, p2_cloud, p3_cloud, k123, df, &
1070 & spline_o%n1, spline_o%x1pkg(1,1), &
1071 & spline_o%n2, spline_o%x2pkg(1,1), &
1072 & spline_o%n3, spline_o%x3pkg(1,1), &
1073 & spline_o%fspl(1,1,1,1), spline_o%n1, spline_o%n2, &
1078 if(ifail /= 0) ier = 95
1080 deallocate(p1_cloud, p2_cloud, p3_cloud, stat=ifail)
1086 end subroutine ezspline_gradient3_array_r4