V3FIT
ezspline_obj.f90
1 module ezspline_obj
2  use ezspline_type
3  interface ezspline_preinit
4  !
5  ! usage: call EZspline_preinit(spline_o)
6  ! ...where spline_o is a 1d, 2d, or 3d spline object of R4 or R8
7  ! precision.
8 
9  module procedure &
10  ezspline_preinit1_r8, &
11  ezspline_preinit2_r8, &
12  ezspline_preinit3_r8, &
13  ezspline_preinit1_r4, &
14  ezspline_preinit2_r4, &
15  ezspline_preinit3_r4
16 
17  end interface
18 
20  ! logical function returns TRUE if allocated, FALSE otherwise
21  !
22  ! usage:
23  ! logical :: answer
24  ! answer = EZspline_allocated(spline_o)
25  ! ...where spline_o is a 1d, 2d, or 3d spline object of R4 or R8
26  ! precision.
27 
28  module procedure &
29  ezspline_allocated1_r8, &
30  ezspline_allocated2_r8, &
31  ezspline_allocated3_r8, &
32  ezspline_allocated1_r4, &
33  ezspline_allocated2_r4, &
34  ezspline_allocated3_r4
35  end interface
36 
37  contains
38 
39  subroutine ezspline_preinit1_r8(spline_o)
40  use ezspline_type
41  type(EZspline1_r8) :: spline_o
42  spline_o%nguard=123456789
43  spline_o%isReady=0
44  spline_o%ibctype1=0
45  end subroutine ezspline_preinit1_r8
46 
47  subroutine ezspline_preinit2_r8(spline_o)
48  use ezspline_type
49  type(EZspline2_r8) :: spline_o
50  spline_o%nguard=123456789
51  spline_o%isReady=0
52  spline_o%ibctype1=0 ; spline_o%ibctype2=0
53  end subroutine ezspline_preinit2_r8
54 
55  subroutine ezspline_preinit3_r8(spline_o)
56  use ezspline_type
57  type(EZspline3_r8) spline_o
58  spline_o%nguard=123456789
59  spline_o%isReady=0
60  spline_o%ibctype1=0 ; spline_o%ibctype2=0 ; spline_o%ibctype3=0
61  end subroutine ezspline_preinit3_r8
62 
63  subroutine ezspline_preinit1_r4(spline_o)
64  use ezspline_type
65  type(EZspline1_r4) spline_o
66  spline_o%nguard=123456789
67  spline_o%isReady=0
68  spline_o%ibctype1=0
69  end subroutine ezspline_preinit1_r4
70 
71  subroutine ezspline_preinit2_r4(spline_o)
72  use ezspline_type
73  type(EZspline2_r4) spline_o
74  spline_o%nguard=123456789
75  spline_o%isReady=0
76  spline_o%ibctype1=0 ; spline_o%ibctype2=0
77  end subroutine ezspline_preinit2_r4
78 
79  subroutine ezspline_preinit3_r4(spline_o)
80  use ezspline_type
81  type(EZspline3_r4) spline_o
82  spline_o%nguard=123456789
83  spline_o%isReady=0
84  spline_o%ibctype1=0 ; spline_o%ibctype2=0 ; spline_o%ibctype3=0
85  end subroutine ezspline_preinit3_r4
86 
87  logical function ezspline_allocated1_r8(spline_o)
88  use ezspline_type
89  type(EZspline1_r8) spline_o
90  ezspline_allocated1_r8 = allocated(spline_o%fspl) &
91  & .and. allocated(spline_o%x1) .and. allocated(spline_o%x1pkg) &
92  & .and. (spline_o%nguard == 123456789) ! check that ezspline_init has been called
93  end function ezspline_allocated1_r8
94 
95  logical function ezspline_allocated2_r8(spline_o)
96  use ezspline_type
97  type(EZspline2_r8) spline_o
98  ezspline_allocated2_r8 = allocated(spline_o%fspl) &
99  & .and. allocated(spline_o%x1) .and. allocated(spline_o%x1pkg) &
100  & .and. allocated(spline_o%x2) .and. allocated(spline_o%x2pkg) &
101  & .and. (spline_o%nguard == 123456789) ! check that ezspline_init has been called
102  end function ezspline_allocated2_r8
103 
104  logical function ezspline_allocated3_r8(spline_o)
105  use ezspline_type
106  type(EZspline3_r8) spline_o
107  ezspline_allocated3_r8 = allocated(spline_o%fspl) &
108  & .and. allocated(spline_o%x1) .and. allocated(spline_o%x1pkg) &
109  & .and. allocated(spline_o%x2) .and. allocated(spline_o%x2pkg) &
110  & .and. allocated(spline_o%x3) .and. allocated(spline_o%x3pkg) &
111  & .and. (spline_o%nguard == 123456789) ! check that ezspline_init has been called
112  end function ezspline_allocated3_r8
113 
114  logical function ezspline_allocated1_r4(spline_o)
115  use ezspline_type
116  type(EZspline1_r4) spline_o
117  ezspline_allocated1_r4 = allocated(spline_o%fspl) &
118  & .and. allocated(spline_o%x1) .and. allocated(spline_o%x1pkg) &
119  & .and. (spline_o%nguard == 123456789) ! check that ezspline_init has been called
120  end function ezspline_allocated1_r4
121 
122  logical function ezspline_allocated2_r4(spline_o)
123  use ezspline_type
124  type(EZspline2_r4) spline_o
125  ezspline_allocated2_r4 = allocated(spline_o%fspl) &
126  & .and. allocated(spline_o%x1) .and. allocated(spline_o%x1pkg) &
127  & .and. allocated(spline_o%x2) .and. allocated(spline_o%x2pkg) &
128  & .and. (spline_o%nguard == 123456789) ! check that ezspline_init has been called
129  end function ezspline_allocated2_r4
130 
131  logical function ezspline_allocated3_r4(spline_o)
132  use ezspline_type
133  type(EZspline3_r4) spline_o
134  ezspline_allocated3_r4 = allocated(spline_o%fspl) &
135  & .and. allocated(spline_o%x1) .and. allocated(spline_o%x1pkg) &
136  & .and. allocated(spline_o%x2) .and. allocated(spline_o%x2pkg) &
137  & .and. allocated(spline_o%x3) .and. allocated(spline_o%x3pkg) &
138  & .and. (spline_o%nguard == 123456789) ! check that ezspline_init has been called
139  end function ezspline_allocated3_r4
140 
141  subroutine ezmake_ict1(i,ict)
142  ! (private utility for ezspline derivative2 subroutines)
143  ! make ict(1:6) array
144  ! for higher derivatives; d[i1+i2]f/dx[i1]dy[i2]
145  ! expecting i in range [0:3] (NOT CHECKED)
146 
147  implicit NONE
148  integer, intent(in) :: i
149  integer, intent(out) :: ict(3)
150 
151  if(i.eq.0) then
152  ict = (/1, 0, 0 /) ! seek f @ (p1)
153  else if(i.eq.1) then
154  ict = (/0, 1, 0 /) ! df/dx
155  else if(i.eq.2) then
156  ict = (/0, 0, 1 /) ! d2f/dx2
157  else
158  ict = (/3, 0, 0 /) ! d3f/dx3
159  endif
160 
161  end subroutine ezmake_ict1
162 
163  subroutine ezmake_ict2(i1,i2,ict)
164  ! (private utility for ezspline derivative2 subroutines)
165  ! make ict(1:6) array
166  ! for higher derivatives; d[i1+i2]f/dx[i1]dy[i2]
167  ! expecting i1 & i2 in range [0:3] (NOT CHECKED)
168 
169  implicit NONE
170  integer, intent(in) :: i1,i2
171  integer, intent(out) :: ict(6)
172 
173  integer :: imark,isum,iii
174 
175  ! this generates the control argument needed by evbicub & similar
176  ! routines...
177  !----------------------
178 
179  isum = i1+i2
180  ict(1)=isum
181 
182  imark=0
183 
184  if(isum.eq.0) then
185  ict = (/1, 0, 0, 0, 0, 0 /) ! seek f @ (p1, p2, p3)
186  else if(isum.eq.1) then
187  if(i1.eq.1) then
188  ict = (/0, 1, 0, 0, 0, 0 /) ! df/dx
189  else
190  ict = (/0, 0, 1, 0, 0, 0 /) ! df/dy
191  endif
192  else if(isum.eq.2) then
193  if(i1.eq.2) then
194  ict = (/0, 0, 0, 1, 0, 0 /) ! d2f/dx2
195  else if(i2.eq.2) then
196  ict = (/0, 0, 0, 0, 1, 0 /) ! d2f/dy2
197  else
198  ict = (/0, 0, 0, 0, 0, 1 /) ! d2f/dxdy
199  endif
200  else if(isum.eq.3) then
201  if(i1.eq.3) then
202  imark=2 ! fxxx
203  else if(i1.eq.2) then
204  imark=3 ! fxxy
205  else if(i1.eq.1) then
206  imark=4 ! fxyy
207  else
208  imark=5 ! fyyy
209  endif
210  else if(isum.eq.4) then
211  if(i1.eq.3) then
212  imark=2 ! fxxxy
213  else if(i2.eq.3) then
214  imark=4 ! fxyyy
215  else
216  imark=3 ! fxxyy
217  endif
218  else if(isum.eq.5) then
219  if(i1.eq.3) then
220  imark=2 ! fxxxyy
221  else if(i2.eq.3) then
222  imark=3 ! fxxyyy
223  endif
224  endif
225 
226  ! isum=6 --> fxxxyyy
227 
228  if(isum.gt.2) then
229  do iii=2,6
230  if(iii.eq.imark) then
231  ict(iii)=1
232  else
233  ict(iii)=0
234  endif
235  enddo
236  endif
237 
238  end subroutine ezmake_ict2
239 
240  subroutine ezmake_ict3(i1,i2,i3,ict)
241  ! (private utility for ezspline derivative3 subroutines)
242  ! make ict(1:10) array
243  ! for higher derivatives; d[i1+i2+i3]f/dx[i1]dy[i2]dz[i3]
244  ! i1 & i2 & i3 in range [0:3] (NOT CHECKED)
245 
246  implicit NONE
247  integer, intent(in) :: i1,i2,i3
248  integer, intent(out) :: ict(10)
249 
250  integer :: imark,isum,iii
251 
252  ! this generates the control argument needed by evtricub & similar
253  ! routines...
254  !----------------------
255 
256  isum = i1+i2+i3
257  if(max(i1,i2,i3).eq.3) then
258  isum=-isum
259  endif
260  ict(1)=isum
261 
262  imark=0
263 
264  if(isum.eq.0) then
265  ict = (/1, 0, 0, 0, 0, 0, 0, 0, 0, 0 /) ! seek f @ (p1, p2, p3)
266 
267  else if(isum.eq.1) then
268 ! 1st derivatives
269  if(i1.eq.1) then
270  ict = (/0, 1, 0, 0, 0, 0, 0, 0, 0, 0 /) ! df/dx
271  else if(i2.eq.1) then
272  ict = (/0, 0, 1, 0, 0, 0, 0, 0, 0, 0 /) ! df/dy
273  else
274  ict = (/0, 0, 0, 1, 0, 0, 0, 0, 0, 0 /) ! df/dz
275  endif
276 
277  else if(isum.eq.2) then
278 ! 2nd derivatives -- legacy ordering; x-precedence ordering for all
279 ! higher derivatives...
280 
281  if(i1.eq.2) then
282  ict = (/0, 0, 0, 0, 1, 0, 0, 0, 0, 0 /) ! d2f/dx2
283  else if(i2.eq.2) then
284  ict = (/0, 0, 0, 0, 0, 1, 0, 0, 0, 0 /) ! d2f/dy2
285  else if(i3.eq.2) then
286  ict = (/0, 0, 0, 0, 0, 0, 1, 0, 0, 0 /) ! d2f/dz2
287  else if(i3.eq.0) then
288  ict = (/0, 0, 0, 0, 0, 0, 0, 1, 0, 0 /) ! d2f/dxdy
289  else if(i2.eq.0) then
290  ict = (/0, 0, 0, 0, 0, 0, 0, 0, 1, 0 /) ! d2f/dxdz
291  else
292  ict = (/0, 0, 0, 0, 0, 0, 0, 0, 0, 1 /) ! d2f/dydz
293  endif
294 
295  else if(isum.eq.3) then
296 ! 3rd derivative, continuous: max(i1,i2,i3)<3
297  if(i1.eq.2) then
298  if(i2.eq.1) then
299  imark=2 ! fxxy
300  else
301  imark=3 ! fxxz
302  endif
303  else if(i1.eq.1) then
304  if(i2.eq.2) then
305  imark=4 ! fxyy
306  else if(i2.eq.1) then
307  imark=5 ! fxyz
308  else
309  imark=6 ! fxzz
310  endif
311  else
312  if(i2.eq.2) then
313  imark=7 ! fyyz
314  else
315  imark=8 ! fyzz
316  endif
317  endif
318 
319  else if(isum.eq.-3) then
320 ! 3rd derivative
321  if(i1.eq.3) then
322  imark=2 ! fxxx
323  else if(i2.eq.3) then
324  imark=3 ! fyyy
325  else if(i3.eq.3) then
326  imark=4 ! fzzz
327  endif
328 
329  else if(isum.eq.4) then
330 ! 4th derivative, continuous: max(i1,i2,i3)<3
331  if(i1.eq.2) then
332  if(i2.eq.2) then
333  imark=2 ! fxxyy
334  else if(i2.eq.1) then
335  imark=3 ! fxxyz
336  else
337  imark=4 ! fxxzz
338  endif
339  else if(i1.eq.1) then
340  if(i2.eq.2) then
341  imark=5 ! fxyyz
342  else
343  imark=6 ! fxyzz
344  endif
345  else
346  imark=7 ! fyyzz
347  endif
348 
349  else if(isum.eq.-4) then
350 ! 4th derivative
351  if(i1.eq.3) then
352  if(i2.eq.1) then
353  imark=2 ! fxxxy
354  else
355  imark=3 ! fxxxz
356  endif
357  else if(i1.eq.1) then
358  if(i2.eq.3) then
359  imark=4 ! fxyyy
360  else
361  imark=5 ! fxzzz
362  endif
363  else
364  if(i2.eq.3) then
365  imark=6 ! fyyyz
366  else
367  imark=7 ! fyzzz
368  endif
369  endif
370 
371  else if(isum.eq.5) then
372 ! 5th derivative, continuous: max(i1,i2,i3)<3
373  if(i3.eq.1) then
374  imark=2 ! fxxyyz
375  else if(i2.eq.1) then
376  imark=3 ! fxxyzz
377  else
378  imark=4 ! fxyyzz
379  endif
380 
381  else if(isum.eq.-5) then
382 ! 5th derivative
383  if(i1.eq.3) then
384  if(i2.eq.2) then
385  imark=2 ! fxxxyy
386  else if(i2.eq.1) then
387  imark=3 ! fxxxyz
388  else
389  imark=4 ! fxxxzz
390  endif
391  else if(i1.eq.2) then
392  if(i2.eq.3) then
393  imark=5 ! fxxyyy
394  else
395  imark=6 ! fxxzzz
396  endif
397  else if(i1.eq.1) then
398  if(i2.eq.3) then
399  imark=7 ! fxyyyz
400  else
401  imark=8 ! fxyzzz
402  endif
403  else
404  if(i2.eq.3) then
405  imark=9 ! fyyyzz
406  else
407  imark=10 ! fyyzzz
408  endif
409  endif
410 
411 ! isum=6 --> fxxyyzz (i1=i2=i3=2)
412  else if(isum.eq.-6) then
413 ! 6th derivative
414  if(i1.eq.3) then
415  if(i2.eq.3) then
416  imark=2 ! fxxxyyy
417  else if(i2.eq.2) then
418  imark=3 ! fxxxyyz
419  else if(i2.eq.1) then
420  imark=4 ! fxxxyzz
421  else
422  imark=5 ! fxxxzzz
423  endif
424  else if(i1.eq.2) then
425  if(i2.eq.3) then
426  imark=6 ! fxxyyyz
427  else if(i2.eq.1) then
428  imark=7 ! fxxyzzz
429  endif
430  else if(i1.eq.1) then
431  if(i2.eq.3) then
432  imark=8 ! fxyyyzz
433  else
434  imark=9 ! fxyyzzz
435  endif
436  else
437  imark=10 ! fyyyzzz
438  endif
439 
440 ! isum=7 not possible
441  else if(isum.eq.-7) then
442 ! 7th derivative
443  if(i1.eq.3) then
444  if(i2.eq.3) then
445  imark=2 ! fxxxyyyz
446  else if(i2.eq.2) then
447  imark=3 ! fxxxyyzz
448  else
449  imark=4 ! fxxxyzzz
450  endif
451  else if(i1.eq.2) then
452  if(i2.eq.3) then
453  imark=5 ! fxxyyyzz
454  else
455  imark=6 ! fxxyyzzz
456  endif
457  else
458  imark=7 ! fxyyyzzz
459  endif
460 
461 ! isum=8 not possible
462  else if(isum.eq.-8) then
463 ! 8th derivative
464  if(i3.eq.2) then
465  imark=2 ! fxxxyyyzz
466  else if(i2.eq.2) then
467  imark=3 ! fxxxyyzzz
468  else
469  imark=4 ! fxxyyyzzz
470  endif
471 
472 ! isum=9 not possible
473 ! isum=-9 --> fxxxyyyzzz
474 
475  endif
476 
477  if(abs(isum).gt.2) then
478  do iii=2,10
479  if(iii.eq.imark) then
480  ict(iii)=1
481  else
482  ict(iii)=0
483  endif
484  enddo
485  endif
486 
487  end subroutine ezmake_ict3
488 
489 end module ezspline_obj
ezspline_obj::ezspline_allocated
Definition: ezspline_obj.f90:19
ezspline_obj::ezspline_preinit
Definition: ezspline_obj.f90:3