c cccccccccccccccccccccccccccccccccccccccccccccccccccccc c c subroutine spline.f c c cccccccccccccccccccccccccccccccccccccccccccccccccccccc subroutine spline( t,y,qpl,qmi,pl,bb,cc,dam) real*8 y(6171),qpl(6171),qmi(6171),t,rstep,lr, & dmi,mi1,mi0,dam, pp,pl0,pl1,dpl,n,s,a,b,c,a1,b1,c1 integer bb,cc,i do 10 i=bb,cc qpl(i)= dlog10(qpl(i)) qmi(i)= dlog10(qmi(i)) 10 continue rstep = dam ccccccccc side point cccccccc lr=y(bb) dpl=1.d1**qpl(bb) dmi=1.d1**qmi(bb) write(*,700)t,lr,dpl,dmi n=(0.2d0/rstep) do 1000 i=bb-1,cc-2 y(bb-1) = y(bb)-0.2d0 y(cc+1) = y(cc)+0.2d0 qpl(bb-1)= qpl(bb) qpl(cc+1)= qpl(cc) qmi(bb-1)= qmi(bb) qmi(cc+1)= qmi(cc) do 800 s=1.d0,n lr=y(i+1)+rstep*s a=qpl(i)/0.08d0 b=-qpl(i+1)/0.04d0 c=qpl(i+2)/0.08d0 a1= qpl(i+1)/0.08d0 b1=-qpl(i+2)/0.04d0 c1= qpl(i+3)/0.08d0 pl0= a*(lr-y(i+1))*(lr-y(i+2))+b*(lr-y(i))*(lr-y(i+2)) & + c*(lr-y(i))*(lr-y(i+1)) pl1= a1*(lr-y(i+2))*(lr-y(i+3))+b1*(lr-y(i+1))*(lr-y(i+3)) & + c1*(lr-y(i+1))*(lr-y(i+2)) pp=0.5d0*(pl0+pl1) dpl=1.d1**pp a=qmi(i)/0.08d0 b=-qmi(i+1)/0.04d0 c=qmi(i+2)/0.08d0 a1= qmi(i+1)/0.08d0 b1=-qmi(i+2)/0.04d0 c1= qmi(i+3)/0.08d0 mi0= a*(lr-y(i+1))*(lr-y(i+2))+b*(lr-y(i))*(lr-y(i+2)) & + c*(lr-y(i))*(lr-y(i+1)) mi1= a1*(lr-y(i+2))*(lr-y(i+3))+b1*(lr-y(i+1))*(lr-y(i+3)) & + c1*(lr-y(i+1))*(lr-y(i+2)) pp=0.5d0*(mi0+mi1) dmi=1.d1**pp 700 format(2x,f5.2,2x,f6.3,2x,e12.4,2x,e12.4) write(*,700)t,lr,dpl,dmi 800 continue 1000 continue end