Fortran Coder

标题: 又麻烦您，我知道错误啥意思，但是不会改，辛苦老师了 [打印本页]

---

作者: freedom    时间: 2016-4-20 14:40
标题: 又麻烦您，我知道错误啥意思，但是不会改，辛苦老师了
错误        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
!  --------------------------------------------------

---

作者: li913    时间: 2016-4-20 17:53
你的 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

!  --------------------------------------------------

QQ截图20160420175223.jpg (27.07 KB, 下载次数: 178)

下载附件

2016-4-20 17:52 上传

---

作者: freedom    时间: 2016-4-20 18:40
谢谢你！

---

欢迎光临 Fortran Coder (http://bbs.fcode.cn/)

Powered by Discuz! X3.2