[Fortran] 纯文本查看 复制代码 Program Baidu_Thlws
Implicit None
Real*8 g
call FLRGS( 0.0D0 , 2.0D0 , F , 0.001D0 , g )
write( * , * ) g
Contains
Real*8 Function F( x )
Real*8 x
F = x ** 2.0D0
End Function F
Subroutine FLRGS(A,B,F,EPS,G)
Real*8 :: T(5),C(5)
Real*8 :: A,B,F,G,S,P,H,AA,BB,W,X,Q,EPS
DATA T/-0.9061798459,-0.5384693101,0.0,0.5384693101,0.9061798459/
DATA C/0.2369268851,0.4786286705,0.5688888889,0.4786286705,0.2369268851/
Integer :: M , I , J
M=1
S=(B-A)*0.001
P=0.0
10H=(B-A)/M
G=0.0
DO 30 I=1,M
AA=A+(I-1)*H
BB=A+I*H
W=0.0
DO 20 J=1,5
X=((BB-AA)*T(J)+(BB+AA))/2.0
W=W+F(X)*C(J)
20 CONTINUE
G=G+W
30CONTINUE
G=G*H/2.0
Q=ABS(G-P)/(1.0+ABS(G))
IF ((Q.GE.EPS).AND.(ABS(H).GT.ABS(S))) THEN
P=G
M=M+1
GOTO 10
END IF
RETURN
End Subroutine FLRGS
End Program Baidu_Thlws
|