1 subroutine r8cubsplb ( tau, c, n, ibcbeg, ibcend )
33 INTEGER,
PARAMETER :: R8=selected_real_kind(12,100)
34 integer ibcbeg,ibcend,n, i,j,l,m
36 real*8 c(4,n),tau(n), divdf1,divdf3,dtau,g
46 c(3,m) = tau(m) - tau(m-1)
47 10 c(4,m) = (c(1,m) - c(1,m-1))/c(3,m)
50 if (ibcbeg-1) 11,15,16
51 11
if (n .gt. 2)
go to 12
59 c(3,1) = c(3,2) + c(3,3)
60 c(2,1) =((c(3,2)+2._r8*c(3,1))*c(4,2)*c(3,3)+
61 > c(3,2)**2*c(4,3))/c(3,1)
70 c(2,1) = 3._r8*c(4,2) - c(3,2)/2._r8*c(2,1)
71 18
if(n .eq. 2)
go to 25
76 g = -c(3,m+1)/c(4,m-1)
77 c(2,m) = g*c(2,m-1) + 3._r8*(c(3,m)*c(4,m+1)+c(3,m+1)*c(4,m))
78 20 c(4,m) = g*c(3,m-1) + 2._r8*(c(3,m) + c(3,m+1))
84 if (ibcend-1) 21,30,24
85 21
if (n .eq. 3 .and. ibcbeg .eq. 0)
go to 22
89 c(2,n) = ((c(3,n)+2._r8*g)*c(4,n)*c(3,n-1)
90 * + c(3,n)**2*(c(1,n-1)-c(1,n-2))/c(3,n-1))/g
96 22 c(2,n) = 2._r8*c(4,n)
100 24 c(2,n) = 3._r8*c(4,n) + c(3,n)/2._r8*c(2,n)
103 25
if (ibcend-1) 26,30,24
104 26
if (ibcbeg .gt. 0)
go to 22
108 28 g = -1._r8/c(4,n-1)
110 29 c(4,n) = g*c(3,n-1) + c(4,n)
111 c(2,n) = (g*c(2,n-1) + c(2,n))/c(4,n)
114 40 c(2,j) = (c(2,j) - c(3,j)*c(2,j+1))/c(4,j)
116 if (j .gt. 0)
go to 40
121 divdf1 = (c(1,i) - c(1,i-1))/dtau
122 divdf3 = c(2,i-1) + c(2,i) - 2._r8*divdf1
123 c(3,i-1) = 2._r8*(divdf1 - c(2,i-1) - divdf3)/dtau
124 50 c(4,i-1) = (divdf3/dtau)*(6._r8/dtau)