又麻烦您，我知道错误啥意思，但是不会改，辛苦老师了

freedom

错误        1        In the INTERFACE to SOLVE, the first dummy argument (FUNC) was of type REAL(KIND=2), whereas the actual argument is of type SUBROUTINE





module autoxinpusen
contains
subroutine solve(func,s,a,b,tol,n)
implicit none
integer::n,i
double precision func,s,a,b,tol,s1,del
do i=1,n/2.d0
call simp(func,s,a,b,n)
n=n*2
call simp(func,s1,a,b,n)
del=abs(s-s1)
if(del<=tol)  exit
end do
s=s1
end subroutine solve

subroutine simp(func,s,a,b,n)
implicit none
integer::n,k
double precision func,s,a,b,t1,t2,f1,f2,h,f3,f4
s=0d0
h=(b-a)/n/2d0
call func(f1,a)
call func(f2,b)
s=f1+f2
!k=0 情况
call func(f1,a+h)
s=s+4d0*f1
do k=1,n-1
t1=a+(2d0*k+1)*h
t2=a+2d0*k*h
call func(f3,t1)
call func(f4,t2)
s=s+f3*4d0+f4*2d0  
end do
s=s*h/3d0
end subroutine simp

subroutine fun1(f,x)
implicit none
double precision f,x
f=1d0/(x**3-2*x-5)
end subroutine fun1
end module autoxinpusen

program main
use autoxinpusen
implicit none
integer::n
double precision a,b,abs,s
write(6,*)'n'
read(5,*)n
write(6,*)'a'
read(5,*)a
write(6,*)'b'
read(5,*)b
write(6,*)'abs'
read(5,*)abs
open(unit=11,file='result.txt')
write(11,*)
call solve(fun1,s,a,b,abs,n)
write(11,*)n,s
pause
end program main
!  --------------------------------------------------
!  Silverfrost FTN95 for Microsoft Visual Studio
!  Free Format FTN95 Source File
!  --------------------------------------------------

freedom

谢谢你！

li913

你的 func是子程序，不是函数，改动图中两处就好。

[Fortran] 纯文本查看 复制代码

module autoxinpusen
contains 
subroutine solve(func,s,a,b,tol,n)
implicit none
integer::n,i
external func
double precision s,a,b,tol,s1,del
do i=1,n/2.d0
call simp(func,s,a,b,n)
n=n*2
call simp(func,s1,a,b,n)
del=abs(s-s1)
if(del<=tol)  exit
end do
s=s1
end subroutine solve

subroutine simp(func,s,a,b,n)
implicit none
integer::n,k
external::func
double precision s,a,b,t1,t2,f1,f2,h,f3,f4
s=0d0
h=(b-a)/n/2d0
call func(f1,a)
call func(f2,b)
s=f1+f2
!k=0 情况
call func(f1,a+h)
s=s+4d0*f1
do k=1,n-1
t1=a+(2d0*k+1)*h
t2=a+2d0*k*h
call func(f3,t1)
call func(f4,t2)
s=s+f3*4d0+f4*2d0  
end do
s=s*h/3d0
end subroutine simp

subroutine fun1(f,x)
implicit none
double precision f,x
f=1d0/(x**3-2*x-5)
end subroutine fun1
end module autoxinpusen

program main
use autoxinpusen
implicit none
integer::n
double precision a,b,abs,s
write(6,*)'n'
read(5,*)n
write(6,*)'a'
read(5,*)a
write(6,*)'b'
read(5,*)b
write(6,*)'abs'
read(5,*)abs
open(unit=11,file='result.txt')
write(11,*)
call solve(fun1,s,a,b,abs,n)
write(11,*)n,s
pause
end program main
!  --------------------------------------------------
!  Silverfrost FTN95 for Microsoft Visual Studio
!  Free Format FTN95 Source File
!  --------------------------------------------------