问题
I am trying to set my function f as an array, but I get the following error:
Program received signal SIGSEGV: Segmentation fault - invalid memory reference.
Backtrace for this error:
#0 0x6f8b36e3
#1 0x6f8a2722
#2 0x402752
#3 0x747bd411
I have to solve the Kepler's equation:f=psi-e*sin(psi)-M for each value of M.So, if I have an array M of dimension 8, my program will calculate 8 zeros. The thing is that, if I write f=psi-e*sin(psi)-M(1) I will calculate the first zero,and if I write f=psi-e*sin(psi)-M(8) I will calculate the last zero.But ,my problem is that if I want to calculate all zeros at once, I would have to write f=psi-e*sin(psi)-M(1:8) and my program should type all zeros, but,that doesnt happen and i get the error i mentioned earlier.Here is the code:
SUBROUTINE (I USED EXTERNALLY):This subroutine is the bisection method (to get zeros):
subroutine bisecc(f,xl,xr,kmax,tol,k,xm)
implicit real*8 (a-h,o-z)
real*8 f
fl=f(xl)
fr=f(xr)
if(fl*fr .gt. 0.0D0) goto 100
do k=1,kmax
xm=(xr+xl)/2.0D0
fm=f(xm)
dif=abs((xr-xl)/xm)
if(dif .lt. tol) goto 200
write(*,*) k,xm!,dif
if (fm*fr .le. 0.0D0) then
xl=xm
fl=fm
else
xr=xm
fr=fm
end if
end do
return
200 write(*,*) 'WISHED PRECISION REACHED'
return
100 write(*,*) 'BAD CHOICE OF DATA'
return
end
MAIN PROGRAM:
include 'bisecc.f'
implicit real*8 (a-h,o-z)
external f
real*8 f
! I WRITE THE INTERVAL OF MY 8 ZEROS(left and right point)
b=0.1D0
xl1=-0.5D0
xr1=0.D0
xl2=xr1+b
xr2=1.D0
xl3=xr2+b
xr3=2.D0
xl4=xr3+b
xr4=3.D0
xl5=xr4+b
xr5=4.D0
xl6=xr5+b
xr6=5.D0
xl7=xr6+b
xr7=6.D0
xl8=xr7+b
xr8=7.D0
kmax=100
tol=0.0001D0
call bisecc(f,xl1,xr1,kmax,tol,k,xm1)
call bisecc(f,xl2,xr2,kmax,tol,k,xm2)
call bisecc(f,xl3,xr3,kmax,tol,k,xm3)
call bisecc(f,xl4,xr4,kmax,tol,k,xm4)
call bisecc(f,xl5,xr5,kmax,tol,k,xm5)
call bisecc(f,xl6,xr6,kmax,tol,k,xm6)
call bisecc(f,xl7,xr7,kmax,tol,k,xm7)
call bisecc(f,xl8,xr8,kmax,tol,k,xm8)
write(*,*) 'Program ended'
stop
end program
real*8 function f(psi)
implicit real*8 (a-h,o-z)
real*8 M(8)
dimension f(8)
e=0.2056D0
pi=acos(-1.0D0)
M=(/pi/4.D0,pi/2.D0,3.D0/4.D0*pi,pi,5.D0/4.D0*pi,3.D0*
& pi/2.D0,7.D0/4.D0*pi,2.D0*pi/)
c=sqrt((1.0D0-e)/(1.0D0+e))
f=psi-e*sin(psi)-M(1:8) !KEPLER EQUATION
return
end function
EXAMPLE:
Here I wanted to calculate the value of psi for the first value of M, M(1)=pi/4.
In http://imgur.com/a/Xdsgf you can see that psi=0.95303344726562489. So I have just calculated the first zero. But, you can also see this message 7 times datos mal elegidos. It means that the program can only show me that zero (for M(1)), and the other 7 zeros are not calculated, because I wrote f=psi-e*sin(psi)-M(1).
What should I write so I can get the result of all zeros instead of 1, like in this example?
回答1:
Because the function f() is used in the bisection routine bisecc(), I think it would be much simpler to pass each input to bisecc() via a DO loop, rather than making f() a function returning an array (because the latter requires to modify bisecc() also). We can pass the value of M to f() in various ways (which is almost FAQ and I believe there are a lot of Q/A pages). One simple way is to contain f() in the main program and use host association for M. So a simplified code may look like
program main
implicit none
integer kmax, kiter, i
real*8 xl( 8 ), xr( 8 ), xans( 8 ), tol, M( 8 ), b, pi
pi = acos(-1.0D0)
kmax = 100
tol = 1.0d-8
M = [ pi/4.D0, pi/2.D0, 3.D0/4.D0*pi, pi, &
5.D0/4.D0*pi, 3.D0*pi/2.D0, 7.D0/4.D0*pi, 2.D0*pi ]
! or M = [( i, i=1,8 )] * pi/4.0D0
! Use a fixed interval for simplicity.
xl = 0.0d0
xr = 10.0d0
xans = 0.0d0
do i = 1, 8
call bisecc( f, xl( i ), xr( i ), kmax, tol, kiter, xans( i ) )
! print *, "check: f(xans(i)) = ", f( xans( i ) )
enddo
contains
function f( psi ) result( res )
implicit none
real*8 psi, e, res
e = 0.2056D0
res = psi - e * sin( psi ) - M( i ) !<-- this "M(i)" refers to that defined above
end function
end program
with an external bisecc routine (a little modified so as not to use GOTO)
subroutine bisecc( f, xl, xr, kmax, tol, k, xm )
implicit none
real*8 f, xl, xr, tol, xm
external f
integer kmax, k
real*8 fl, fr, fm, dif
fl = f( xl )
fr = f( xr )
if( fl * fr > 0.0D0 ) then
write(*,*) "bad input data (xl,xr)"
return
endif
do k = 1, kmax
xm = (xr + xl) / 2.0D0
fm = f( xm )
dif = abs( (xr-xl) / xm )
if ( dif < tol ) then
write(*,*) "bisection converged: k=", k, "xm=", xm
return
endif
if ( fm * fr <= 0.0D0 ) then
xl = xm
fl = fm
else
xr = xm
fr = fm
end if
end do !! iteration
write(*,*) "bisection did not converge: k=", k, "xm=", xm
end
which gives
bisection converged: k= 31 xm= 0.95299366395920515
bisection converged: k= 31 xm= 1.7722388869151473
bisection converged: k= 30 xm= 2.4821592587977648
bisection converged: k= 30 xm= 3.1415926571935415
bisection converged: k= 29 xm= 3.8010260276496410
bisection converged: k= 29 xm= 4.5109464414417744
bisection converged: k= 29 xm= 5.3301916457712650
bisection converged: k= 29 xm= 6.2831853143870831
The answer seems to agree with the plot of the Kepler equation with e = 0.2056 (so bisecc() is probably OK).
The above code still has a lot of points for improvement. In particular, it is usually more convenient to include a function like f() into a module (or even include all routines into a module). We can also pass M by making it a module variable and use it from f() (rather than using common statements) or via host association, so please try it if interested.
回答2:
MY SOLUTION:I will add a more generic solution to my exercise,avoiding the mentioned error.This is a more generic solution,for N values of M,instead of 8:
include 'bisecc.f'
implicit real*8 (a-h,o-z)
external f
parameter (Mlong=100) !Number of elemnts of M(from 0 to 2pi)
real*8 f ,M
common M,e !to not copy them twice
kmax=100 !max number of iterations
tol=0.0001D0 !Tolerance of 0.01%
e=0.2056D0 !Mercury excentricity
pi=acos(-1.0D0)
c=sqrt((1.0D0-e)/(1.0D0+e))
open(10,file='153b.dat',status='unknown') !data will apear in a .dat file
write(*,*)' i M Theta(rad)'
write(10,*)' i M Theta(rad)'
do i=1,Mlong
xl=-1.D0 !LEFT STARTING POINT
xr=7.D0 !RIGHT POINT(psi wont be more than 2*pi)
M=2.D0*pi*i/Mlong !GENERIC M(0 TO 2PI 100STEPS)
call bisecc(f,xl,xr,kmax,tol,k,xm) !CALLING THE SUBROUTINE
write(10,*) i,M,theta ! I WILL PLOT THETA IN FUNCTION OF M
write(*,*) i,M,theta
end do
close(10)
write(*,*)
write(*,*) 'Program ENDED'
stop
end program
*MY EXTERNAL FUNCTION
real*8 function f(psi)
implicit real*8 (a-h,o-z)
real*8 M
common M,e
f=psi-e*sin(psi)-M !KEPLER EQUATION
return
end function
来源：https://stackoverflow.com/questions/42460615/do-loop-only-prints-last-value