1
2! Copyright (C) 2019 J. K. Dewhurst, S. Sharma and E. K. U. Gross.
3! This file is distributed under the terms of the GNU General Public License.
4! See the file COPYING for license details.
5
6subroutine wspline(n,x,wc)
7implicit none
8! arguments
9integer, intent(in) :: n
10real(8), intent(in) :: x(n)
11real(8), intent(out) :: wc(4,3,n)
12! local variables
13integer i,j
14real(8) f(4),cf(3,4)
15if (n.lt.4) then
16  write(*,*)
17  write(*,'("Error(wspline): n < 4 : ",I8)') n
18  write(*,*)
19  stop
20end if
21f(1)=1.d0
22f(2:)=0.d0
23call spline(4,x,f,cf)
24wc(1,:,1)=cf(:,1)
25wc(1,:,2)=cf(:,2)
26f(1)=0.d0
27f(2)=1.d0
28call spline(4,x,f,cf)
29wc(2,:,1)=cf(:,1)
30wc(2,:,2)=cf(:,2)
31f(2)=0.d0
32f(3)=1.d0
33call spline(4,x,f,cf)
34wc(3,:,1)=cf(:,1)
35wc(3,:,2)=cf(:,2)
36f(3)=0.d0
37f(4)=1.d0
38call spline(4,x,f,cf)
39wc(4,:,1)=cf(:,1)
40wc(4,:,2)=cf(:,2)
41do i=3,n-3
42  j=i-1
43  f(1)=1.d0
44  f(2:)=0.d0
45  call spline(4,x(j),f,cf)
46  wc(1,:,i)=cf(:,2)
47  f(1)=0.d0
48  f(2)=1.d0
49  call spline(4,x(j),f,cf)
50  wc(2,:,i)=cf(:,2)
51  f(2)=0.d0
52  f(3)=1.d0
53  call spline(4,x(j),f,cf)
54  wc(3,:,i)=cf(:,2)
55  f(3)=0.d0
56  f(4)=1.d0
57  call spline(4,x(j),f,cf)
58  wc(4,:,i)=cf(:,2)
59end do
60j=n-3
61f(1)=1.d0
62f(2:)=0.d0
63call spline(4,x(j),f,cf)
64wc(1,:,n-2)=cf(:,2)
65wc(1,:,n-1)=cf(:,3)
66wc(1,:,n)=cf(:,4)
67f(1)=0.d0
68f(2)=1.d0
69call spline(4,x(j),f,cf)
70wc(2,:,n-2)=cf(:,2)
71wc(2,:,n-1)=cf(:,3)
72wc(2,:,n)=cf(:,4)
73f(2)=0.d0
74f(3)=1.d0
75call spline(4,x(j),f,cf)
76wc(3,:,n-2)=cf(:,2)
77wc(3,:,n-1)=cf(:,3)
78wc(3,:,n)=cf(:,4)
79f(3)=0.d0
80f(4)=1.d0
81call spline(4,x(j),f,cf)
82wc(4,:,n-2)=cf(:,2)
83wc(4,:,n-1)=cf(:,3)
84wc(4,:,n)=cf(:,4)
85end subroutine
86
87