主题:(求助)数值计算子函数返回值问题。。。
请高手指教下
--------------------Configuration: qq - Win32 Debug--------------------
Compiling Fortran...
C:\Program Files\Microsoft Visual Studio\Common\MSDEV98\My Projects\qq.f90
C:\Program Files\Microsoft Visual Studio\Common\MSDEV98\My Projects\qq.f90(20) : Warning: In the call to GH3, actual argument #1 has no corresponding dummy argument.
G3=GH3(COS)
-----------------^
C:\Program Files\Microsoft Visual Studio\Common\MSDEV98\My Projects\qq.f90(42) : Warning: In the call to GH2, actual argument #1 does not match the type and kind of the corresponding dummy argument.
G2=GH2(P,cos)
----------------^
C:\Program Files\Microsoft Visual Studio\Common\MSDEV98\My Projects\qq.f90(42) : Warning: In the call to GH2, actual argument #2 does not match the type and kind of the corresponding dummy argument.
G2=GH2(P,cos)
------------------^
C:\Program Files\Microsoft Visual Studio\Common\MSDEV98\My Projects\qq.f90(61) : Warning: In the call to GH, actual argument #1 does not match the type and kind of the corresponding dummy argument.
G=GH(K)
--------------^
C:\Program Files\Microsoft Visual Studio\Common\MSDEV98\My Projects\qq.f90(20) : Warning: Routine GH3 called with different number and/or type of actual arguments in earlier call - C attribute required if intended.
G3=GH3(COS)
-------------^
qq.obj - 0 error(s), 5 warning(s)
external f4
DOUBLE PRECISION F4,A,B,S
COMMON P,K,COS
A=0.0
B=10.0
EPS=0.000001
CALL FSIMP(A,B,F4,EPS,S)
WRITE(*,10) S
10 FORMAT(1X,'S=',D15.6)
END
FUNCTION F4(cos)
DOUBLE PRECISION F4,cos,g3
EXTERNAL GH3
G3=GH3(COS)
f4=g3
RETURN
END
function gH3
EXTERNAL F3
DOUBLE PRECISION F3,G3
COMMON P,COS
CALL FLAGS(F3,G3)
GH3=G3
END
FUNCTION F3(p)
DOUBLE PRECISION F3,p,COS,G2
EXTERNAL GH2
G2=GH2(P,cos)
mh=0.139
f3=(p**3)/sqrt(p**2+mh**2)*g2
END
function gH2(P,COS)
EXTERNAL F2
DOUBLE PRECISION F2,G2
COMMON K
CALL FLAGS(F2,G2)
GH2=G2
END
FUNCTION F2(k)
DOUBLE PRECISION F2,k,P,G
COMMON P,COS
EXTERNAL GH
G=GH(K)
pi=3.1415926
m1=0.53
m2=0.53
m=m1+m2
mh=0.139
temp=((p/m)**2)+((k/m1)**2)
t=100
f2=8.0*pi**2*g*g*k*k*exp(-(m1*sqrt(1+temp+2*p*k*cos/(m1*m))+1)/t-(m2*sqrt(1+temp-2*p*k*cos/(m2*m)))/t)
END
function GH(K)
EXTERNAL F1
DOUBLE PRECISION F1,G1
CALL FLAGS(F1,G1)
GH=G1
END
FUNCTION F1(x)
DOUBLE PRECISION F1,x
COMMON K
pi=3.1415926
yita=0.9
temp=0.05**2
k=1
g1=(-16*pi*0.54)/(3*(x**2+temp))
g2=64*pi*pi*0.54**2*0.25**3/(9*0.35**3*(x**2+temp))
g3=32*pi*pi*0.54**2*0.25**3*0.8/(9*0.53**3*(x**2+temp))
g4=-64*pi*pi*0.54**2*0.25**3/(9*0.35**3*((x**2+temp)+0.35**2))
g5=-32*pi*pi*0.54**2*0.25**3*0.8/(9*0.53**3*((x**2+temp)+0.53**2))
g6=-64*pi*pi*0.54**2*0.25**3/(9*0.35*(x**2+temp)**2)
g7=-32*pi*pi*0.54**2*0.25**3*0.8/(9*0.53*(x**2+temp)**2)
g8=-8*pi**3*0.54*0.36**4/((x**2+temp)**3)
g=g1+g2+g3+g4+g5+g6+g7+g8
u=(2*PI)**3*3.9685766*(SQRT(YITA))**3*k
f1=x*(exp(-yita**2*(x+k)**2)-exp(-yita**2*(x-k)**2))*g*sqrt(pi)/u
END
SUBROUTINE FLAGS(F,G)
DIMENSION T(5),C(5)
DOUBLE PRECISION F,G,T,C,X
DATA C/0.6790941054,1.638487956,2.769426772,4.31594400,7.104896230/
DATA T/0.26355990,1.41340290,3.59642600,7.08580990,12.64080000/
G=0.0D0
DO 10 I=1,5
X=T(I)
G=G+F(X)*C(I)
10 CONTINUE
END
SUBROUTINE FSIMP(A,B,F,EPS,T)
DOUBLE PRECISION A,B,F,T,H,T1,S1,P,X,T2,S2
N=1
H=B-A
T1=H*(F(A)+F(B))/2.0
S1=T1
10 P=0.0
DO 20 K=0,N-1
X=A+(K+0.5)*H
P=P+F(X)
20 CONTINUE
T2=(T1+H*P)/2.0
S2=(4*T2-T1)/3.0
IF (ABS(S2-S1).GE.EPS) THEN
T1=T2
N=N+N
H=H/2.0
S1=S2
GOTO 10
END IF
T=S2
RETURN
END
--------------------Configuration: qq - Win32 Debug--------------------
Compiling Fortran...
C:\Program Files\Microsoft Visual Studio\Common\MSDEV98\My Projects\qq.f90
C:\Program Files\Microsoft Visual Studio\Common\MSDEV98\My Projects\qq.f90(20) : Warning: In the call to GH3, actual argument #1 has no corresponding dummy argument.
G3=GH3(COS)
-----------------^
C:\Program Files\Microsoft Visual Studio\Common\MSDEV98\My Projects\qq.f90(42) : Warning: In the call to GH2, actual argument #1 does not match the type and kind of the corresponding dummy argument.
G2=GH2(P,cos)
----------------^
C:\Program Files\Microsoft Visual Studio\Common\MSDEV98\My Projects\qq.f90(42) : Warning: In the call to GH2, actual argument #2 does not match the type and kind of the corresponding dummy argument.
G2=GH2(P,cos)
------------------^
C:\Program Files\Microsoft Visual Studio\Common\MSDEV98\My Projects\qq.f90(61) : Warning: In the call to GH, actual argument #1 does not match the type and kind of the corresponding dummy argument.
G=GH(K)
--------------^
C:\Program Files\Microsoft Visual Studio\Common\MSDEV98\My Projects\qq.f90(20) : Warning: Routine GH3 called with different number and/or type of actual arguments in earlier call - C attribute required if intended.
G3=GH3(COS)
-------------^
qq.obj - 0 error(s), 5 warning(s)
external f4
DOUBLE PRECISION F4,A,B,S
COMMON P,K,COS
A=0.0
B=10.0
EPS=0.000001
CALL FSIMP(A,B,F4,EPS,S)
WRITE(*,10) S
10 FORMAT(1X,'S=',D15.6)
END
FUNCTION F4(cos)
DOUBLE PRECISION F4,cos,g3
EXTERNAL GH3
G3=GH3(COS)
f4=g3
RETURN
END
function gH3
EXTERNAL F3
DOUBLE PRECISION F3,G3
COMMON P,COS
CALL FLAGS(F3,G3)
GH3=G3
END
FUNCTION F3(p)
DOUBLE PRECISION F3,p,COS,G2
EXTERNAL GH2
G2=GH2(P,cos)
mh=0.139
f3=(p**3)/sqrt(p**2+mh**2)*g2
END
function gH2(P,COS)
EXTERNAL F2
DOUBLE PRECISION F2,G2
COMMON K
CALL FLAGS(F2,G2)
GH2=G2
END
FUNCTION F2(k)
DOUBLE PRECISION F2,k,P,G
COMMON P,COS
EXTERNAL GH
G=GH(K)
pi=3.1415926
m1=0.53
m2=0.53
m=m1+m2
mh=0.139
temp=((p/m)**2)+((k/m1)**2)
t=100
f2=8.0*pi**2*g*g*k*k*exp(-(m1*sqrt(1+temp+2*p*k*cos/(m1*m))+1)/t-(m2*sqrt(1+temp-2*p*k*cos/(m2*m)))/t)
END
function GH(K)
EXTERNAL F1
DOUBLE PRECISION F1,G1
CALL FLAGS(F1,G1)
GH=G1
END
FUNCTION F1(x)
DOUBLE PRECISION F1,x
COMMON K
pi=3.1415926
yita=0.9
temp=0.05**2
k=1
g1=(-16*pi*0.54)/(3*(x**2+temp))
g2=64*pi*pi*0.54**2*0.25**3/(9*0.35**3*(x**2+temp))
g3=32*pi*pi*0.54**2*0.25**3*0.8/(9*0.53**3*(x**2+temp))
g4=-64*pi*pi*0.54**2*0.25**3/(9*0.35**3*((x**2+temp)+0.35**2))
g5=-32*pi*pi*0.54**2*0.25**3*0.8/(9*0.53**3*((x**2+temp)+0.53**2))
g6=-64*pi*pi*0.54**2*0.25**3/(9*0.35*(x**2+temp)**2)
g7=-32*pi*pi*0.54**2*0.25**3*0.8/(9*0.53*(x**2+temp)**2)
g8=-8*pi**3*0.54*0.36**4/((x**2+temp)**3)
g=g1+g2+g3+g4+g5+g6+g7+g8
u=(2*PI)**3*3.9685766*(SQRT(YITA))**3*k
f1=x*(exp(-yita**2*(x+k)**2)-exp(-yita**2*(x-k)**2))*g*sqrt(pi)/u
END
SUBROUTINE FLAGS(F,G)
DIMENSION T(5),C(5)
DOUBLE PRECISION F,G,T,C,X
DATA C/0.6790941054,1.638487956,2.769426772,4.31594400,7.104896230/
DATA T/0.26355990,1.41340290,3.59642600,7.08580990,12.64080000/
G=0.0D0
DO 10 I=1,5
X=T(I)
G=G+F(X)*C(I)
10 CONTINUE
END
SUBROUTINE FSIMP(A,B,F,EPS,T)
DOUBLE PRECISION A,B,F,T,H,T1,S1,P,X,T2,S2
N=1
H=B-A
T1=H*(F(A)+F(B))/2.0
S1=T1
10 P=0.0
DO 20 K=0,N-1
X=A+(K+0.5)*H
P=P+F(X)
20 CONTINUE
T2=(T1+H*P)/2.0
S2=(4*T2-T1)/3.0
IF (ABS(S2-S1).GE.EPS) THEN
T1=T2
N=N+N
H=H/2.0
S1=S2
GOTO 10
END IF
T=S2
RETURN
END