4 subroutine ezspline_setup1_r8(spline_o, f, ier, exact_dim)
7 type(EZspline1_r8) spline_o
8 real(ezspline_r8),
dimension(:),
intent(in) :: f
12 integer,
intent(out) :: ier
14 logical,
intent(in),
OPTIONAL :: exact_dim
21 integer iper, imsg, itol, inum, in1
22 real(ezspline_r8) ztol, df1, df2
26 if(
present(exact_dim)) iexact = exact_dim
33 in1 =
size(spline_o%fspl,2)
36 if(
size(f,1).lt.in1)
return
40 if(
size(f,1).gt.in1)
return
46 spline_o%x1max = maxval(spline_o%x1)
47 spline_o%x1min = minval(spline_o%x1)
52 ztol=5.e-7_ezspline_r8
54 if(spline_o%ibctype1(1)==-1 .OR. spline_o%ibctype1(2)==-1) iper=1
55 call r8genxpkg(spline_o%n1, spline_o%x1(1), spline_o%x1pkg(1,1),&
56 & iper,imsg,itol,ztol, spline_o%klookup1 ,ifail)
61 spline_o%fspl(1, 1:in1) = &
64 if (spline_o%isHermite == 0 .and. spline_o%isLinear == 0)
then
67 & spline_o%x1(1), spline_o%n1, &
68 & spline_o%fspl(1,1), &
69 & spline_o%ibctype1(1), spline_o%bcval1min, &
70 & spline_o%ibctype1(2), spline_o%bcval1max, &
71 & spline_o%ilin1, ifail)
79 else if (spline_o%isLinear == 1)
then
83 if(spline_o%x1pkg(3,4).eq.0.0_ezspline_r8) spline_o%ilin1=1
96 if (spline_o%ibctype1(1)==-1 .or. spline_o%ibctype1(2)==-1)
then
98 else if (spline_o%ibctype1(1)<-1 .or. spline_o%ibctype1(1)>1 .or. &
99 spline_o%ibctype1(2)<-1 .or. spline_o%ibctype1(2)>1 )
then
101 else if (spline_o%ibctype1(1)==1 .or. spline_o%ibctype1(2)==1)
then
103 if(spline_o%ibctype1(1)==1)
then
104 spline_o%fspl(2,1)=spline_o%bcval1min
107 df1=(spline_o%fspl(1,2)-spline_o%fspl(1,1))/ &
108 (spline_o%x1(2)-spline_o%x1(1))
109 df2=(spline_o%fspl(1,3)-spline_o%fspl(1,2))/ &
110 (spline_o%x1(3)-spline_o%x1(2))
111 spline_o%fspl(2,1)=(3*df1-df2)/2
114 if(spline_o%ibctype1(2)==1)
then
115 spline_o%fspl(2,inum)=spline_o%bcval1max
118 df1=(spline_o%fspl(1,inum)-spline_o%fspl(1,inum-1))/ &
119 (spline_o%x1(inum)-spline_o%x1(inum-1))
120 df2=(spline_o%fspl(1,inum-1)-spline_o%fspl(1,inum-2))/ &
121 (spline_o%x1(inum-1)-spline_o%x1(inum-2))
122 spline_o%fspl(2,inum)=(3*df1-df2)/2
126 call r8akherm1p(spline_o%x1(1), spline_o%n1, &
127 & spline_o%fspl(1,1), &
140 end subroutine ezspline_setup1_r8
143 subroutine ezspline_setup2_r8(spline_o, f, ier, exact_dim)
146 type(EZspline2_r8) spline_o
147 real(ezspline_r8),
dimension(:,:),
intent(in) :: f
151 integer,
intent(out) :: ier
153 logical,
intent(in),
OPTIONAL :: exact_dim
160 integer iper, imsg, itol, inum, ii, jj, in0, in1, in2
161 real(ezspline_r8) ztol, df1, df2
165 if(
present(exact_dim)) iexact = exact_dim
172 in0 =
size(spline_o%fspl,1)
173 in1 =
size(spline_o%fspl,2)
174 in2 =
size(spline_o%fspl,3)
177 if(
size(f,1).lt.in1)
return
178 if(
size(f,2).lt.in2)
return
182 if(
size(f,1).gt.in1)
return
183 if(
size(f,2).gt.in2)
return
189 spline_o%x1max = maxval(spline_o%x1)
190 spline_o%x2max = maxval(spline_o%x2)
191 spline_o%x1min = minval(spline_o%x1)
192 spline_o%x2min = minval(spline_o%x2)
198 ztol=5.e-7_ezspline_r8
200 if(spline_o%ibctype1(1)==-1 .OR. spline_o%ibctype1(2)==-1) iper=1
201 call r8genxpkg(spline_o%n1,spline_o%x1(1),spline_o%x1pkg(1,1),&
202 & iper,imsg,itol,ztol,spline_o%klookup1,ifail)
205 if(spline_o%ibctype2(1)==-1 .OR. spline_o%ibctype2(2)==-1) iper=1
206 call r8genxpkg(spline_o%n2,spline_o%x2(1),spline_o%x2pkg(1,1),&
207 & iper,imsg,itol,ztol,spline_o%klookup2,ifail)
212 spline_o%fspl(1, 1:in1, 1:in2) = &
216 if(ztol.eq.-1.2345d30) &
217 write(6,*)
'spline_o%fspl(1,1,1) = ', spline_o%fspl(1,1,1)
219 if (spline_o%isHybrid == 1)
then
222 & spline_o%x1(1), spline_o%n1, &
223 & spline_o%x2(1), spline_o%n2, &
224 & spline_o%hspline, spline_o%fspl(1,1,1), &
226 & spline_o%ibctype1(1), spline_o%bcval1min(1), &
227 & spline_o%ibctype1(2), spline_o%bcval1max(1), &
228 & spline_o%ibctype2(1), spline_o%bcval2min(1), &
229 & spline_o%ibctype2(2), spline_o%bcval2max(1), &
241 else if (spline_o%isHermite == 0 .and. spline_o%isLinear == 0)
then
244 & spline_o%x1(1), spline_o%n1, &
245 & spline_o%x2(1), spline_o%n2, &
246 & spline_o%fspl(1,1,1), spline_o%n1, &
247 & spline_o%ibctype1(1), spline_o%bcval1min(1), &
248 & spline_o%ibctype1(2), spline_o%bcval1max(1), &
249 & spline_o%ibctype2(1), spline_o%bcval2min(1), &
250 & spline_o%ibctype2(2), spline_o%bcval2max(1), &
251 & spline_o%ilin1, spline_o%ilin2, ifail)
259 else if (spline_o%isLinear == 1)
then
263 if(spline_o%x1pkg(3,4).eq.0.0_ezspline_r8) spline_o%ilin1=1
270 if(spline_o%x2pkg(3,4).eq.0.0_ezspline_r8) spline_o%ilin2=1
283 if (spline_o%ibctype1(1)==-1 .or. spline_o%ibctype1(2)==-1)
then
285 else if (spline_o%ibctype1(1)<-1 .or. spline_o%ibctype1(1)>1 .or. &
286 spline_o%ibctype1(2)<-1 .or. spline_o%ibctype1(2)>1 )
then
288 else if (spline_o%ibctype1(1)==1 .or. spline_o%ibctype1(2)==1)
then
291 if(spline_o%ibctype1(1)==1)
then
292 spline_o%fspl(2,1,jj)=spline_o%bcval1min(jj)
295 df1=(spline_o%fspl(1,2,jj)-spline_o%fspl(1,1,jj))/ &
296 (spline_o%x1(2)-spline_o%x1(1))
297 df2=(spline_o%fspl(1,3,jj)-spline_o%fspl(1,2,jj))/ &
298 (spline_o%x1(3)-spline_o%x1(2))
299 spline_o%fspl(2,1,jj)=(3*df1-df2)/2
302 if(spline_o%ibctype1(2)==1)
then
303 spline_o%fspl(2,inum,jj)=spline_o%bcval1max(jj)
306 df1=(spline_o%fspl(1,inum,jj)-spline_o%fspl(1,inum-1,jj))/ &
307 (spline_o%x1(inum)-spline_o%x1(inum-1))
308 df2=(spline_o%fspl(1,inum-1,jj)-spline_o%fspl(1,inum-2,jj))/ &
309 (spline_o%x1(inum-1)-spline_o%x1(inum-2))
310 spline_o%fspl(2,inum,jj)=(3*df1-df2)/2
315 if (spline_o%ibctype2(1)==-1 .or. spline_o%ibctype2(2)==-1)
then
317 else if (spline_o%ibctype2(1)<-1 .or. spline_o%ibctype2(1)>1 .or. &
318 spline_o%ibctype2(2)<-1 .or. spline_o%ibctype2(2)>1 )
then
320 else if (spline_o%ibctype2(1)==1 .or. spline_o%ibctype2(2)==1)
then
323 if(spline_o%ibctype2(1)==1)
then
324 spline_o%fspl(3,ii,1)=spline_o%bcval2min(ii)
327 df1=(spline_o%fspl(1,ii,2)-spline_o%fspl(1,ii,1))/ &
328 (spline_o%x2(2)-spline_o%x2(1))
329 df2=(spline_o%fspl(1,ii,3)-spline_o%fspl(1,ii,2))/ &
330 (spline_o%x2(3)-spline_o%x2(2))
331 spline_o%fspl(3,ii,1)=(3*df1-df2)/2
334 if(spline_o%ibctype2(2)==1)
then
335 spline_o%fspl(3,ii,inum)=spline_o%bcval2max(ii)
338 df1=(spline_o%fspl(1,ii,inum)-spline_o%fspl(1,ii,inum-1))/ &
339 (spline_o%x2(inum)-spline_o%x2(inum-1))
340 df2=(spline_o%fspl(1,ii,inum-1)-spline_o%fspl(1,ii,inum-2))/ &
341 (spline_o%x2(inum-1)-spline_o%x2(inum-2))
342 spline_o%fspl(3,ii,inum)=(3*df1-df2)/2
347 call r8akherm2p(spline_o%x1(1), spline_o%n1, &
348 & spline_o%x2(1), spline_o%n2, &
349 & spline_o%fspl(1,1,1), spline_o%n1, &
350 & spline_o%ilin1, spline_o%ilin2, &
362 end subroutine ezspline_setup2_r8
366 subroutine ezspline_setup3_r8(spline_o, f, ier, exact_dim)
369 type(EZspline3_r8) spline_o
370 real(ezspline_r8),
dimension(:,:,:),
intent(in) :: f
374 integer,
intent(out) :: ier
376 logical,
intent(in),
OPTIONAL :: exact_dim
382 integer :: ipx, ipy, ipz
383 integer iper, imsg, itol, inum, ii, jj, in0, in1, in2, in3
384 real(ezspline_r8) ztol, df1, df2
388 if(
present(exact_dim)) iexact = exact_dim
395 in0 =
size(spline_o%fspl,1)
396 in1 =
size(spline_o%fspl,2)
397 in2 =
size(spline_o%fspl,3)
398 in3 =
size(spline_o%fspl,4)
401 if(
size(f,1).lt.in1)
return
402 if(
size(f,2).lt.in2)
return
403 if(
size(f,3).lt.in3)
return
407 if(
size(f,1).gt.in1)
return
408 if(
size(f,2).gt.in2)
return
409 if(
size(f,3).gt.in3)
return
415 spline_o%x1max = maxval(spline_o%x1)
416 spline_o%x2max = maxval(spline_o%x2)
417 spline_o%x3max = maxval(spline_o%x3)
418 spline_o%x1min = minval(spline_o%x1)
419 spline_o%x2min = minval(spline_o%x2)
420 spline_o%x3min = minval(spline_o%x3)
426 ztol=5.e-7_ezspline_r8
428 if(spline_o%ibctype1(1)==-1 .OR. spline_o%ibctype1(2)==-1) iper=1
429 call r8genxpkg(spline_o%n1,spline_o%x1(1),spline_o%x1pkg(1,1),&
430 & iper,imsg,itol,ztol,spline_o%klookup1,ifail)
433 if(spline_o%ibctype2(1)==-1 .OR. spline_o%ibctype2(2)==-1) iper=1
434 call r8genxpkg(spline_o%n2,spline_o%x2(1),spline_o%x2pkg(1,1),&
435 & iper,imsg,itol,ztol,spline_o%klookup2,ifail)
438 if(spline_o%ibctype3(1)==-1 .OR. spline_o%ibctype3(2)==-1) iper=1
439 call r8genxpkg(spline_o%n3,spline_o%x3(1),spline_o%x3pkg(1,1),&
440 & iper,imsg,itol,ztol,spline_o%klookup3,ifail)
445 spline_o%fspl(1, 1:in1, 1:in2, 1:in3) = &
446 & f(1:in1, 1:in2, 1:in3)
448 if (spline_o%isHybrid == 1)
then
451 & spline_o%x1(1), spline_o%n1, &
452 & spline_o%x2(1), spline_o%n2, &
453 & spline_o%x3(1), spline_o%n3, &
454 & spline_o%hspline, spline_o%fspl(1,1,1,1), &
456 & spline_o%ibctype1(1), spline_o%bcval1min(1,1), &
457 & spline_o%ibctype1(2), spline_o%bcval1max(1,1), &
458 & spline_o%ibctype2(1), spline_o%bcval2min(1,1), &
459 & spline_o%ibctype2(2), spline_o%bcval2max(1,1), &
460 & spline_o%ibctype3(1), spline_o%bcval3min(1,1), &
461 & spline_o%ibctype3(2), spline_o%bcval3max(1,1), &
474 else if (spline_o%isHermite == 0 .and. spline_o%isLinear == 0)
then
477 & spline_o%x1(1), spline_o%n1, &
478 & spline_o%x2(1), spline_o%n2, &
479 & spline_o%x3(1), spline_o%n3, &
480 & spline_o%fspl(1,1,1,1), spline_o%n1, spline_o%n2, &
481 & spline_o%ibctype1(1), spline_o%bcval1min(1,1), &
482 & spline_o%ibctype1(2), spline_o%bcval1max(1,1), spline_o%n2, &
483 & spline_o%ibctype2(1), spline_o%bcval2min(1,1), &
484 & spline_o%ibctype2(2), spline_o%bcval2max(1,1), spline_o%n1, &
485 & spline_o%ibctype3(1), spline_o%bcval3min(1,1), &
486 & spline_o%ibctype3(2), spline_o%bcval3max(1,1), spline_o%n1, &
487 & spline_o%ilin1, spline_o%ilin2, spline_o%ilin3, ifail)
495 else if (spline_o%isLinear == 1)
then
499 if(spline_o%x1pkg(3,4).eq.0.0_ezspline_r8) spline_o%ilin1=1
506 if(spline_o%x2pkg(3,4).eq.0.0_ezspline_r8) spline_o%ilin2=1
513 if(spline_o%x3pkg(3,4).eq.0.0_ezspline_r8) spline_o%ilin3=1
526 if (spline_o%ibctype1(1)==-1 .or. spline_o%ibctype1(2)==-1)
then
528 else if (spline_o%ibctype1(1)<-1 .or. spline_o%ibctype1(1)>1 .or. &
529 spline_o%ibctype1(2)<-1 .or. spline_o%ibctype1(2)>1 )
then
531 else if (spline_o%ibctype1(1)==1 .or. spline_o%ibctype1(2)==1)
then
535 if(spline_o%ibctype1(1)==1)
then
536 spline_o%fspl(2,1,ii,jj)=spline_o%bcval1min(ii,jj)
539 df1=(spline_o%fspl(1,2,ii,jj)-spline_o%fspl(1,1,ii,jj))/ &
540 (spline_o%x1(2)-spline_o%x1(1))
541 df2=(spline_o%fspl(1,3,ii,jj)-spline_o%fspl(1,2,ii,jj))/ &
542 (spline_o%x1(3)-spline_o%x1(2))
543 spline_o%fspl(2,1,ii,jj)=(3*df1-df2)/2
546 if(spline_o%ibctype1(2)==1)
then
547 spline_o%fspl(2,inum,ii,jj)=spline_o%bcval1max(ii,jj)
550 df1=(spline_o%fspl(1,inum,ii,jj)-spline_o%fspl(1,inum-1,ii,jj))/ &
551 (spline_o%x1(inum)-spline_o%x1(inum-1))
552 df2=(spline_o%fspl(1,inum-1,ii,jj)-spline_o%fspl(1,inum-2,ii,jj))/ &
553 (spline_o%x1(inum-1)-spline_o%x1(inum-2))
554 spline_o%fspl(2,inum,ii,jj)=(3*df1-df2)/2
560 if (spline_o%ibctype2(1)==-1 .or. spline_o%ibctype2(2)==-1)
then
562 else if (spline_o%ibctype2(1)<-1 .or. spline_o%ibctype2(1)>1 .or. &
563 spline_o%ibctype2(2)<-1 .or. spline_o%ibctype2(2)>1 )
then
565 else if (spline_o%ibctype2(1)==1 .or. spline_o%ibctype2(2)==1)
then
569 if(spline_o%ibctype2(1)==1)
then
570 spline_o%fspl(3,ii,1,jj)=spline_o%bcval2min(ii,jj)
573 df1=(spline_o%fspl(1,ii,2,jj)-spline_o%fspl(1,ii,1,jj))/ &
574 (spline_o%x2(2)-spline_o%x2(1))
575 df2=(spline_o%fspl(1,ii,3,jj)-spline_o%fspl(1,ii,2,jj))/ &
576 (spline_o%x2(3)-spline_o%x2(2))
577 spline_o%fspl(3,ii,1,jj)=(3*df1-df2)/2
580 if(spline_o%ibctype2(2)==1)
then
581 spline_o%fspl(3,ii,inum,jj)=spline_o%bcval2max(ii,jj)
584 df1=(spline_o%fspl(1,ii,inum,jj)-spline_o%fspl(1,ii,inum-1,jj))/ &
585 (spline_o%x2(inum)-spline_o%x2(inum-1))
586 df2=(spline_o%fspl(1,ii,inum-1,jj)-spline_o%fspl(1,ii,inum-2,jj))/ &
587 (spline_o%x2(inum-1)-spline_o%x2(inum-2))
588 spline_o%fspl(3,ii,inum,jj)=(3*df1-df2)/2
594 if (spline_o%ibctype3(1)==-1 .or. spline_o%ibctype3(2)==-1)
then
596 else if (spline_o%ibctype3(1)<-1 .or. spline_o%ibctype3(1)>1 .or. &
597 spline_o%ibctype3(2)<-1 .or. spline_o%ibctype3(2)>1 )
then
599 else if (spline_o%ibctype3(1)==1 .or. spline_o%ibctype3(2)==1)
then
603 if(spline_o%ibctype3(1)==1)
then
604 spline_o%fspl(4,ii,jj,1)=spline_o%bcval3min(ii,jj)
607 df1=(spline_o%fspl(1,ii,jj,2)-spline_o%fspl(1,ii,jj,1))/ &
608 (spline_o%x3(2)-spline_o%x3(1))
609 df2=(spline_o%fspl(1,ii,jj,3)-spline_o%fspl(1,ii,jj,2))/ &
610 (spline_o%x3(3)-spline_o%x3(2))
611 spline_o%fspl(4,ii,jj,1)=(3*df1-df2)/2
614 if(spline_o%ibctype3(2)==1)
then
615 spline_o%fspl(4,ii,jj,inum)=spline_o%bcval3max(ii,jj)
618 df1=(spline_o%fspl(1,ii,jj,inum)-spline_o%fspl(1,ii,jj,inum-1))/ &
619 (spline_o%x3(inum)-spline_o%x3(inum-1))
620 df2=(spline_o%fspl(1,ii,jj,inum-1)-spline_o%fspl(1,ii,jj,inum-2))/ &
621 (spline_o%x3(inum-1)-spline_o%x3(inum-2))
622 spline_o%fspl(4,ii,jj,inum)=(3*df1-df2)/2
628 call r8akherm3p(spline_o%x1(1), spline_o%n1, &
629 & spline_o%x2(1), spline_o%n2, &
630 & spline_o%x3(1), spline_o%n3, &
631 & spline_o%fspl(1,1,1,1), spline_o%n1, spline_o%n2, &
632 & spline_o%ilin1, spline_o%ilin2, spline_o%ilin3, &
633 & ipx,ipy,ipz, ifail)
644 end subroutine ezspline_setup3_r8
648 subroutine ezspline_setup1_r4(spline_o, f, ier, exact_dim)
651 type(EZspline1_r4) spline_o
652 real(ezspline_r4),
dimension(:),
intent(in) :: f
656 integer,
intent(out) :: ier
658 logical,
intent(in),
OPTIONAL :: exact_dim
665 integer iper, imsg, itol, inum, in1
666 real(ezspline_r4) ztol, df1, df2
670 if(
present(exact_dim)) iexact = exact_dim
677 in1 =
size(spline_o%fspl,2)
680 if(
size(f,1).lt.in1)
return
684 if(
size(f,1).gt.in1)
return
690 spline_o%x1max = maxval(spline_o%x1)
691 spline_o%x1min = minval(spline_o%x1)
697 ztol=5.e-7_ezspline_r4
699 if(spline_o%ibctype1(1)==-1 .OR. spline_o%ibctype1(2)==-1) iper=1
700 call genxpkg(spline_o%n1, spline_o%x1(1), spline_o%x1pkg(1,1),&
701 & iper,imsg,itol,ztol,spline_o%klookup1,ifail)
706 spline_o%fspl(1, 1:in1) = &
709 if (spline_o%isHermite == 0 .and. spline_o%isLinear == 0)
then
712 & spline_o%x1(1), spline_o%n1, &
713 & spline_o%fspl(1,1), &
714 & spline_o%ibctype1(1), spline_o%bcval1min, &
715 & spline_o%ibctype1(2), spline_o%bcval1max, &
716 & spline_o%ilin1, ifail)
724 else if (spline_o%isLinear == 1)
then
728 if(spline_o%x1pkg(3,4).eq.0.0_ezspline_r4) spline_o%ilin1=1
741 if (spline_o%ibctype1(1)==-1 .or. spline_o%ibctype1(2)==-1)
then
743 else if (spline_o%ibctype1(1)<-1 .or. spline_o%ibctype1(1)>1 .or. &
744 spline_o%ibctype1(2)<-1 .or. spline_o%ibctype1(2)>1 )
then
746 else if (spline_o%ibctype1(1)==1 .or. spline_o%ibctype1(2)==1)
then
748 if(spline_o%ibctype1(1)==1)
then
749 spline_o%fspl(2,1)=spline_o%bcval1min
752 df1=(spline_o%fspl(1,2)-spline_o%fspl(1,1))/ &
753 (spline_o%x1(2)-spline_o%x1(1))
754 df2=(spline_o%fspl(1,3)-spline_o%fspl(1,2))/ &
755 (spline_o%x1(3)-spline_o%x1(2))
756 spline_o%fspl(2,1)=(3*df1-df2)/2
759 if(spline_o%ibctype1(2)==1)
then
760 spline_o%fspl(2,inum)=spline_o%bcval1max
763 df1=(spline_o%fspl(1,inum)-spline_o%fspl(1,inum-1))/ &
764 (spline_o%x1(inum)-spline_o%x1(inum-1))
765 df2=(spline_o%fspl(1,inum-1)-spline_o%fspl(1,inum-2))/ &
766 (spline_o%x1(inum-1)-spline_o%x1(inum-2))
767 spline_o%fspl(2,inum)=(3*df1-df2)/2
771 call akherm1p(spline_o%x1(1), spline_o%n1, &
772 & spline_o%fspl(1,1), &
785 end subroutine ezspline_setup1_r4
788 subroutine ezspline_setup2_r4(spline_o, f, ier, exact_dim)
791 type(EZspline2_r4) spline_o
792 real(ezspline_r4),
dimension(:,:),
intent(in) :: f
796 integer,
intent(out) :: ier
798 logical,
intent(in),
OPTIONAL :: exact_dim
805 integer iper, imsg, itol, inum, ii, jj, in0, in1, in2
806 real(ezspline_r4) ztol, df1, df2
810 if(
present(exact_dim)) iexact = exact_dim
817 in0 =
size(spline_o%fspl,1)
818 in1 =
size(spline_o%fspl,2)
819 in2 =
size(spline_o%fspl,3)
822 if(
size(f,1).lt.in1)
return
823 if(
size(f,2).lt.in2)
return
827 if(
size(f,1).gt.in1)
return
828 if(
size(f,2).gt.in2)
return
834 spline_o%x1max = maxval(spline_o%x1)
835 spline_o%x2max = maxval(spline_o%x2)
836 spline_o%x1min = minval(spline_o%x1)
837 spline_o%x2min = minval(spline_o%x2)
842 ztol=5.e-7_ezspline_r4
844 if(spline_o%ibctype1(1)==-1 .OR. spline_o%ibctype1(2)==-1) iper=1
845 call genxpkg(spline_o%n1,spline_o%x1(1),spline_o%x1pkg(1,1),&
846 & iper,imsg,itol,ztol,spline_o%klookup1,ifail)
849 if(spline_o%ibctype2(1)==-1 .OR. spline_o%ibctype2(2)==-1) iper=1
850 call genxpkg(spline_o%n2,spline_o%x2(1),spline_o%x2pkg(1,1),&
851 & iper,imsg,itol,ztol,spline_o%klookup2,ifail)
856 spline_o%fspl(1, 1:in1, 1:in2) = &
859 if (spline_o%isHybrid == 1)
then
862 & spline_o%x1(1), spline_o%n1, &
863 & spline_o%x2(1), spline_o%n2, &
864 & spline_o%hspline, spline_o%fspl(1,1,1), &
866 & spline_o%ibctype1(1), spline_o%bcval1min(1), &
867 & spline_o%ibctype1(2), spline_o%bcval1max(1), &
868 & spline_o%ibctype2(1), spline_o%bcval2min(1), &
869 & spline_o%ibctype2(2), spline_o%bcval2max(1), &
881 else if (spline_o%isHermite == 0 .and. spline_o%isLinear == 0)
then
884 & spline_o%x1(1), spline_o%n1, &
885 & spline_o%x2(1), spline_o%n2, &
886 & spline_o%fspl(1,1,1), spline_o%n1, &
887 & spline_o%ibctype1(1), spline_o%bcval1min(1), &
888 & spline_o%ibctype1(2), spline_o%bcval1max(1), &
889 & spline_o%ibctype2(1), spline_o%bcval2min(1), &
890 & spline_o%ibctype2(2), spline_o%bcval2max(1), &
891 & spline_o%ilin1, spline_o%ilin2, ifail)
899 else if (spline_o%isLinear == 1)
then
903 if(spline_o%x1pkg(3,4).eq.0.0_ezspline_r4) spline_o%ilin1=1
910 if(spline_o%x2pkg(3,4).eq.0.0_ezspline_r4) spline_o%ilin2=1
923 if (spline_o%ibctype1(1)==-1 .or. spline_o%ibctype1(2)==-1)
then
925 else if (spline_o%ibctype1(1)<-1 .or. spline_o%ibctype1(1)>1 .or. &
926 spline_o%ibctype1(2)<-1 .or. spline_o%ibctype1(2)>1 )
then
928 else if (spline_o%ibctype1(1)==1 .or. spline_o%ibctype1(2)==1)
then
931 if(spline_o%ibctype1(1)==1)
then
932 spline_o%fspl(2,1,jj)=spline_o%bcval1min(jj)
935 df1=(spline_o%fspl(1,2,jj)-spline_o%fspl(1,1,jj))/ &
936 (spline_o%x1(2)-spline_o%x1(1))
937 df2=(spline_o%fspl(1,3,jj)-spline_o%fspl(1,2,jj))/ &
938 (spline_o%x1(3)-spline_o%x1(2))
939 spline_o%fspl(2,1,jj)=(3*df1-df2)/2
942 if(spline_o%ibctype1(2)==1)
then
943 spline_o%fspl(2,inum,jj)=spline_o%bcval1max(jj)
946 df1=(spline_o%fspl(1,inum,jj)-spline_o%fspl(1,inum-1,jj))/ &
947 (spline_o%x1(inum)-spline_o%x1(inum-1))
948 df2=(spline_o%fspl(1,inum-1,jj)-spline_o%fspl(1,inum-2,jj))/ &
949 (spline_o%x1(inum-1)-spline_o%x1(inum-2))
950 spline_o%fspl(2,inum,jj)=(3*df1-df2)/2
955 if (spline_o%ibctype2(1)==-1 .or. spline_o%ibctype2(2)==-1)
then
957 else if (spline_o%ibctype2(1)<-1 .or. spline_o%ibctype2(1)>1 .or. &
958 spline_o%ibctype2(2)<-1 .or. spline_o%ibctype2(2)>1 )
then
960 else if (spline_o%ibctype2(1)==1 .or. spline_o%ibctype2(2)==1)
then
963 if(spline_o%ibctype2(1)==1)
then
964 spline_o%fspl(3,ii,1)=spline_o%bcval2min(ii)
967 df1=(spline_o%fspl(1,ii,2)-spline_o%fspl(1,ii,1))/ &
968 (spline_o%x2(2)-spline_o%x2(1))
969 df2=(spline_o%fspl(1,ii,3)-spline_o%fspl(1,ii,2))/ &
970 (spline_o%x2(3)-spline_o%x2(2))
971 spline_o%fspl(3,ii,1)=(3*df1-df2)/2
974 if(spline_o%ibctype2(2)==1)
then
975 spline_o%fspl(3,ii,inum)=spline_o%bcval2max(ii)
978 df1=(spline_o%fspl(1,ii,inum)-spline_o%fspl(1,ii,inum-1))/ &
979 (spline_o%x2(inum)-spline_o%x2(inum-1))
980 df2=(spline_o%fspl(1,ii,inum-1)-spline_o%fspl(1,ii,inum-2))/ &
981 (spline_o%x2(inum-1)-spline_o%x2(inum-2))
982 spline_o%fspl(3,ii,inum)=(3*df1-df2)/2
987 call akherm2p(spline_o%x1(1), spline_o%n1, &
988 & spline_o%x2(1), spline_o%n2, &
989 & spline_o%fspl(1,1,1), spline_o%n1, &
990 & spline_o%ilin1, spline_o%ilin2, &
1002 end subroutine ezspline_setup2_r4
1006 subroutine ezspline_setup3_r4(spline_o, f, ier, exact_dim)
1009 type(EZspline3_r4) spline_o
1010 real(ezspline_r4),
dimension(:,:,:),
intent(in) :: f
1014 integer,
intent(out) :: ier
1016 logical,
intent(in),
OPTIONAL :: exact_dim
1022 integer :: ipx, ipy, ipz
1023 integer iper, imsg, itol, inum, ii, jj, in0, in1, in2, in3
1024 real(ezspline_r4) ztol, df1, df2
1028 if(
present(exact_dim)) iexact = exact_dim
1035 in0 =
size(spline_o%fspl,1)
1036 in1 =
size(spline_o%fspl,2)
1037 in2 =
size(spline_o%fspl,3)
1038 in3 =
size(spline_o%fspl,4)
1041 if(
size(f,1).lt.in1)
return
1042 if(
size(f,2).lt.in2)
return
1043 if(
size(f,3).lt.in3)
return
1047 if(
size(f,1).gt.in1)
return
1048 if(
size(f,2).gt.in2)
return
1049 if(
size(f,3).gt.in3)
return
1055 spline_o%x1max = maxval(spline_o%x1)
1056 spline_o%x2max = maxval(spline_o%x2)
1057 spline_o%x3max = maxval(spline_o%x3)
1058 spline_o%x1min = minval(spline_o%x1)
1059 spline_o%x2min = minval(spline_o%x2)
1060 spline_o%x3min = minval(spline_o%x3)
1066 ztol=5.e-7_ezspline_r4
1068 if(spline_o%ibctype1(1)==-1 .OR. spline_o%ibctype1(2)==-1) iper=1
1069 call genxpkg(spline_o%n1,spline_o%x1(1),spline_o%x1pkg(1,1),&
1070 & iper,imsg,itol,ztol,spline_o%klookup1,ifail)
1073 if(spline_o%ibctype2(1)==-1 .OR. spline_o%ibctype2(2)==-1) iper=1
1074 call genxpkg(spline_o%n2,spline_o%x2(1),spline_o%x2pkg(1,1),&
1075 & iper,imsg,itol,ztol,spline_o%klookup2,ifail)
1078 if(spline_o%ibctype3(1)==-1 .OR. spline_o%ibctype3(2)==-1) iper=1
1079 call genxpkg(spline_o%n3,spline_o%x3(1),spline_o%x3pkg(1,1),&
1080 & iper,imsg,itol,ztol,spline_o%klookup3,ifail)
1083 spline_o%isReady = 0
1085 spline_o%fspl(1, 1:in1, 1:in2, 1:in3) = &
1086 & f(1:in1, 1:in2, 1:in3)
1088 if (spline_o%isHybrid == 1)
then
1091 & spline_o%x1(1), spline_o%n1, &
1092 & spline_o%x2(1), spline_o%n2, &
1093 & spline_o%x3(1), spline_o%n3, &
1094 & spline_o%hspline, spline_o%fspl(1,1,1,1), &
1095 & in0,in1,in2,in3, &
1096 & spline_o%ibctype1(1), spline_o%bcval1min(1,1), &
1097 & spline_o%ibctype1(2), spline_o%bcval1max(1,1), &
1098 & spline_o%ibctype2(1), spline_o%bcval2min(1,1), &
1099 & spline_o%ibctype2(2), spline_o%bcval2max(1,1), &
1100 & spline_o%ibctype3(1), spline_o%bcval3min(1,1), &
1101 & spline_o%ibctype3(2), spline_o%bcval3max(1,1), &
1111 spline_o%isReady = 1
1114 else if (spline_o%isHermite == 0 .and. spline_o%isLinear == 0)
then
1117 & spline_o%x1(1), spline_o%n1, &
1118 & spline_o%x2(1), spline_o%n2, &
1119 & spline_o%x3(1), spline_o%n3, &
1120 & spline_o%fspl(1,1,1,1), spline_o%n1, spline_o%n2, &
1121 & spline_o%ibctype1(1), spline_o%bcval1min(1,1), &
1122 & spline_o%ibctype1(2), spline_o%bcval1max(1,1), spline_o%n2, &
1123 & spline_o%ibctype2(1), spline_o%bcval2min(1,1), &
1124 & spline_o%ibctype2(2), spline_o%bcval2max(1,1), spline_o%n1, &
1125 & spline_o%ibctype3(1), spline_o%bcval3min(1,1), &
1126 & spline_o%ibctype3(2), spline_o%bcval3max(1,1), spline_o%n1, &
1127 & spline_o%ilin1, spline_o%ilin2, spline_o%ilin3, ifail)
1132 spline_o%isReady = 1
1135 else if (spline_o%isLinear == 1)
then
1139 if(spline_o%x1pkg(3,4).eq.0.0_ezspline_r4) spline_o%ilin1=1
1146 if(spline_o%x2pkg(3,4).eq.0.0_ezspline_r4) spline_o%ilin2=1
1153 if(spline_o%x3pkg(3,4).eq.0.0_ezspline_r4) spline_o%ilin3=1
1158 spline_o%isReady = 1
1166 if (spline_o%ibctype1(1)==-1 .or. spline_o%ibctype1(2)==-1)
then
1168 else if (spline_o%ibctype1(1)<-1 .or. spline_o%ibctype1(1)>1 .or. &
1169 spline_o%ibctype1(2)<-1 .or. spline_o%ibctype1(2)>1 )
then
1171 else if (spline_o%ibctype1(1)==1 .or. spline_o%ibctype1(2)==1)
then
1175 if(spline_o%ibctype1(1)==1)
then
1176 spline_o%fspl(2,1,ii,jj)=spline_o%bcval1min(ii,jj)
1179 df1=(spline_o%fspl(1,2,ii,jj)-spline_o%fspl(1,1,ii,jj))/ &
1180 (spline_o%x1(2)-spline_o%x1(1))
1181 df2=(spline_o%fspl(1,3,ii,jj)-spline_o%fspl(1,2,ii,jj))/ &
1182 (spline_o%x1(3)-spline_o%x1(2))
1183 spline_o%fspl(2,1,ii,jj)=(3*df1-df2)/2
1186 if(spline_o%ibctype1(2)==1)
then
1187 spline_o%fspl(2,inum,ii,jj)=spline_o%bcval1max(ii,jj)
1190 df1=(spline_o%fspl(1,inum,ii,jj)-spline_o%fspl(1,inum-1,ii,jj))/ &
1191 (spline_o%x1(inum)-spline_o%x1(inum-1))
1192 df2=(spline_o%fspl(1,inum-1,ii,jj)-spline_o%fspl(1,inum-2,ii,jj))/ &
1193 (spline_o%x1(inum-1)-spline_o%x1(inum-2))
1194 spline_o%fspl(2,inum,ii,jj)=(3*df1-df2)/2
1200 if (spline_o%ibctype2(1)==-1 .or. spline_o%ibctype2(2)==-1)
then
1202 else if (spline_o%ibctype2(1)<-1 .or. spline_o%ibctype2(1)>1 .or. &
1203 spline_o%ibctype2(2)<-1 .or. spline_o%ibctype2(2)>1 )
then
1205 else if (spline_o%ibctype2(1)==1 .or. spline_o%ibctype2(2)==1)
then
1209 if(spline_o%ibctype2(1)==1)
then
1210 spline_o%fspl(3,ii,1,jj)=spline_o%bcval2min(ii,jj)
1213 df1=(spline_o%fspl(1,ii,2,jj)-spline_o%fspl(1,ii,1,jj))/ &
1214 (spline_o%x2(2)-spline_o%x2(1))
1215 df2=(spline_o%fspl(1,ii,3,jj)-spline_o%fspl(1,ii,2,jj))/ &
1216 (spline_o%x2(3)-spline_o%x2(2))
1217 spline_o%fspl(3,ii,1,jj)=(3*df1-df2)/2
1220 if(spline_o%ibctype2(2)==1)
then
1221 spline_o%fspl(3,ii,inum,jj)=spline_o%bcval2max(ii,jj)
1224 df1=(spline_o%fspl(1,ii,inum,jj)-spline_o%fspl(1,ii,inum-1,jj))/ &
1225 (spline_o%x2(inum)-spline_o%x2(inum-1))
1226 df2=(spline_o%fspl(1,ii,inum-1,jj)-spline_o%fspl(1,ii,inum-2,jj))/ &
1227 (spline_o%x2(inum-1)-spline_o%x2(inum-2))
1228 spline_o%fspl(3,ii,inum,jj)=(3*df1-df2)/2
1234 if (spline_o%ibctype3(1)==-1 .or. spline_o%ibctype3(2)==-1)
then
1236 else if (spline_o%ibctype3(1)<-1 .or. spline_o%ibctype3(1)>1 .or. &
1237 spline_o%ibctype3(2)<-1 .or. spline_o%ibctype3(2)>1 )
then
1239 else if (spline_o%ibctype3(1)==1 .or. spline_o%ibctype3(2)==1)
then
1243 if(spline_o%ibctype3(1)==1)
then
1244 spline_o%fspl(4,ii,jj,1)=spline_o%bcval3min(ii,jj)
1247 df1=(spline_o%fspl(1,ii,jj,2)-spline_o%fspl(1,ii,jj,1))/ &
1248 (spline_o%x3(2)-spline_o%x3(1))
1249 df2=(spline_o%fspl(1,ii,jj,3)-spline_o%fspl(1,ii,jj,2))/ &
1250 (spline_o%x3(3)-spline_o%x3(2))
1251 spline_o%fspl(4,ii,jj,1)=(3*df1-df2)/2
1254 if(spline_o%ibctype3(2)==1)
then
1255 spline_o%fspl(4,ii,jj,inum)=spline_o%bcval3max(ii,jj)
1258 df1=(spline_o%fspl(1,ii,jj,inum)-spline_o%fspl(1,ii,jj,inum-1))/ &
1259 (spline_o%x3(inum)-spline_o%x3(inum-1))
1260 df2=(spline_o%fspl(1,ii,jj,inum-1)-spline_o%fspl(1,ii,jj,inum-2))/ &
1261 (spline_o%x3(inum-1)-spline_o%x3(inum-2))
1262 spline_o%fspl(4,ii,jj,inum)=(3*df1-df2)/2
1268 call akherm3p(spline_o%x1(1), spline_o%n1, &
1269 & spline_o%x2(1), spline_o%n2, &
1270 & spline_o%x3(1), spline_o%n3, &
1271 & spline_o%fspl(1,1,1,1), spline_o%n1, spline_o%n2, &
1272 & spline_o%ilin1, spline_o%ilin2, spline_o%ilin3, &
1273 & ipx,ipy,ipz, ifail)
1275 if (ifail /=0 )
then
1278 spline_o%isReady = 1
1284 end subroutine ezspline_setup3_r4