9 pure subroutine rdiracint(sol,kpa,e,nr,r,vr,nn,g0,g1,f0,f1)
45 real(8),
intent(in) ::
sol 46 integer,
intent(in) :: kpa
47 real(8),
intent(in) :: e
48 integer,
intent(in) :: nr
49 real(8),
intent(in) :: r(nr),vr(nr)
50 integer,
intent(out) :: nn
51 real(8),
intent(out) :: g0(nr),g1(nr),f0(nr),f1(nr)
54 real(8) ci,e0,t1,t2,t3,t4
77 g1(ir)=
poly3(r(ir0),g1(ir0),r(ir))
78 f1(ir)=
poly3(r(ir0),f1(ir0),r(ir))
81 g0(ir)=
poly4i(r(ir0),g1(ir0),r(ir))+g0(ir0)
82 f0(ir)=
poly4i(r(ir0),f1(ir0),r(ir))+f0(ir0)
84 g1(ir)=t3*f0(ir)-t2*g0(ir)
85 f1(ir)=t4*g0(ir)+t2*f0(ir)
88 if (abs(g0(ir)) > 1.d100)
then 90 g0(ir+1:nr)=g0(ir); g1(ir+1:nr)=g1(ir)
91 f0(ir+1:nr)=f0(ir); f1(ir+1:nr)=f1(ir)
95 if (g0(ir-1)*g0(ir) < 0.d0) nn=nn+1
100 pure real(8) function poly3(xa,ya,x)
103 real(8),
intent(in) :: xa(3),ya(3),x
105 real(8) x0,x1,x2,y0,y1,y2
106 real(8) c1,c2,t0,t1,t2
109 x1=xa(2)-x0; x2=xa(3)-x0
111 y1=ya(2)-y0; y2=ya(3)-y0
112 t0=1.d0/(x1*x2*(x2-x1))
118 poly3=y0+t0*t1*(c1+c2*t1)
121 pure real(8) function poly4i(xa,ya,x)
124 real(8),
intent(in) :: xa(4),ya(4),x
126 real(8) x0,x1,x2,x3,y0,y1,y2,y3
127 real(8) c1,c2,c3,t0,t1,t2,t3,t4,t5,t6
130 x1=xa(2)-x0; x2=xa(3)-x0; x3=xa(4)-x0
132 y1=ya(2)-y0; y2=ya(3)-y0; y3=ya(4)-y0
133 t4=x1-x2; t5=x1-x3; t6=x2-x3
134 t1=x1*x2*y3; t2=x2*x3*y1; t3=x1*x3
135 t0=1.d0/(x2*t3*t4*t5*t6)
138 t4=x1**2; t5=x2**2; t6=x3**2
139 c2=t1*(t5-t4)+t2*(t6-t5)+t3*(t4-t6)
140 c1=t1*(x2*t4-x1*t5)+t2*(x3*t5-x2*t6)+t3*(x1*t6-x3*t4)
143 poly4i=t1*(y0+t0*t1*(0.5d0*c1+t1*(0.3333333333333333333d0*c2+0.25d0*c3*t1)))
pure real(8) function poly3(xa, ya, x)
pure subroutine rdiracint(sol, kpa, e, nr, r, vr, nn, g0, g1, f0, f1)
pure real(8) function poly4i(xa, ya, x)