program razb use dfimsl implicit none ! Variables integer::i,y,n,ig,jg,m,m0,j real(8)::ll=-1.0,ul=1.0 real(8)::F,G,T external F,G,T real(8)::e=1e-4 real(8)::tau(3),q(3),a(8) real(8)::f1,x,s1,s2,hg,pi,xb,xj,temp,f2,xg real(8)::errabs=1e-10,errrel=1e-10,errest ! Body of razb pi=acos(-1.0) tau(1)=-0.7745966692 tau(2)=0.0 tau(3)=-tau(1) q(1)=0.5555555556 q(2)=0.8888888888 q(3)=q(1) do i=1,8,1 do j=1,3,1 a(i)=a(i)+F(tau(j))*T(tau(j),i)/sqrt(1-tau(j)*tau(j))*q(j) enddo if (i==1) then a(i)=a(i)/pi else a(i)=a(i)*2/pi end if enddo do i=1,8,1 f1=f1+a(i)*T(tau(3),i) enddo print*,'F~=',f1 do i=1,8,1 call DQDAGS(G,ll,ul,errabs,errrel,a(i),errest) a(i)=a(i)*2/pi*T(tau(3),i) enddo a(1)=a(1)/2 do i=1,8,1 f2=f2+a(i) enddo print*, 'f(x)=',f2 end program razb real FUNCTION T(x,i) implicit none real(8)::x,TT(8) integer::i,j if (i==1) then TT=1 else if (i==2) then TT=x else do j=3,i,1 TT(j)=2*x*TT(j-1)-TT(j-2) enddo end if T=TT(i) end FUNCTION T real FUNCTION F(x) implicit none real(8)::x F=exp(-x) end FUNCTION F real(8) FUNCTION G(x,i) implicit none real(8)::x real(8)::TT(8) integer::i,j if (i==1) then TT(i)=1 else if (i==2) then TT(i)=x else do j=3,i,1 TT(j)=2*x*TT(j-1)-TT(j-2) enddo end if G=exp(-x)*TT(i)/(1-sqrt(x*x)) end FUNCTION G |