Related
I am getting an error while I run this code. When I run the code with small L's like L=16 or L=32 I get no error but in L = 128 or L=96 after 7000-8000 steps I get following error :
Program received signal SIGSEGV: Segmentation fault - invalid memory reference.
Backtrace for this error:
#0 0x7FBA5CAC3E08
#1 0x7FBA5CAC2F90
#2 0x7FBA5C1E84AF
#3 0x402769 in MAIN__ at newhys.f90:?
Segmentation fault (core dumped)
This is the full code :
SUBROUTINE init_random_seed()
implicit none
INTEGER :: i, n, clock
INTEGER, DIMENSION(:), ALLOCATABLE :: seed
CALL RANDOM_SEED(size = n)
ALLOCATE(seed(n))
CALL SYSTEM_CLOCK(COUNT=clock)
seed = clock + 37 * (/ (i - 1, i = 1, n) /)
CALL RANDOM_SEED(PUT = seed)
DEALLOCATE(seed)
END SUBROUTINE
!end module
Program Activ_mater
USE OMP_LIB
Implicit none
Integer,parameter :: time=1000000000, L=128, N = L**2*2
Integer,parameter:: n_thread = 8
Real(8),parameter :: pi = 3.14159265359
Real(8),parameter :: v0 = 0.50, alpha = 1.0/36.0
real(8)START,END_1 ,eta
type block_p
Integer :: partical_N
Integer :: particle_ad(10*L)
end type
Type(block_p) ,pointer,dimension(:,:) :: C
Real(8),allocatable :: x(:), y(:) , phi,angle_new(:),angle(:)
Real(8) :: sum_a, sum_b,x_in, y_in, x_out, y_out, avrage_t, r,ra,eta1(5)
Integer :: i,j,t,n_p,I_b,J_b,b_l,neighbor_i(9),neighbor_j(9),A,n_p_b,ne = 1,stateta=0,ot=0,op=175
character(len=10)::name1
call omp_set_num_threads(n_thread)
call init_random_seed()
eta1=(/2.100,2.116,2.120,2.126,2.128/) ! The value of ETA
allocate(x(2*n), y(2*n) , phi,angle_new(2*N),angle(2*N))
allocate(C(2*L,2*L))
C(:,:)%partical_N=0
do i =1,N
call random_number(ra)
x(i)=ra*L
I_b = int(x(i))+1
call random_number(ra)
y(i)=ra*L
J_b = int(y(i))+1
call random_number(ra)
angle(i)=ra*2.0*pi
C(I_b,J_b)%partical_N = C(I_b,J_b)%partical_N + 1 !Number of particle in block C(I_b,J_b)
C(I_b,J_b)%particle_ad( C(I_b,J_b)%partical_N ) = i ! The particle number in block C(I_b,J_b)
end do
! loop for eta
eta= 0.0
write(name1,'(f5.3)')eta
open(unit=10, file='Hysteresis,'//trim(name1)//'.dat')
!=====================explanation of system====================================
print*,'==========================================================================='
print*, 'eta = ', etA ,' ',' alpha = ',alpha
print*,'L=',L ,' ', 'Particle Number=', N,' ','Density=', N/L**2
print*,'==========================================================================='
!==============================================================================
START = omp_get_wtime()
do t =1,time
if (ot == 300000 )then
stateta = 0
ot = 0
op = op + 1
end if
if (stateta == 0 )then
eta = eta + ((1.0/3.0) * (10E-6))
endif
if (int(eta * 100) == op) then
stateta = 1
end if
angle_new(:)=0
!$OMP PARALLEL DEFAULT(PRIVATE) SHARED(x,y,angle,angle_new,c) firstprivate(eta)
!$OMP DO schedule(runtime)
do i =1, N
sum_a=0; sum_b=0;n_p=0
I_b = int(x(i))+1; J_b = int(y(i))+1 ! The block of particle i
! Now I should find nine neighbor of particle i-----------------------------------------------
neighbor_i=(/I_b+1, I_b, I_b-1, I_b, I_b+1, I_b-1, I_b-1, I_b+1, I_b/)
neighbor_j=(/J_b, J_b+1, J_b, J_b-1, J_b+1, J_b+1, J_b-1, J_b-1, J_b/)
do b_l = 1, 9
I_b = neighbor_i(b_l) ; J_b=neighbor_j(b_l)
if (I_b >L )I_b=1
if (I_b <1 )I_b=L
if (J_b >L )J_b=1
if (J_b <1 )J_b=L
!neighbor_i(b_l)=I_b; neighbor_j(b_l)=J_b
A = C( I_b, J_b )%partical_N ! number of particle in block C( neighbor_i(b_l), neighbor_j(b_l) )
!=============================================================================================
do n_p_b =1, A
j = C( I_b, J_b)%particle_ad(n_p_b) !particle j in the block C
if (i /= j )then
X_in = abs(max(x(i),x(j)) - min(x(i),x(j)));
Y_in = abs(max(y(i),y(j)) - min(y(i),y(j)));
X_out =L-X_in
Y_out =L-Y_in
r = sqrt(min(X_in,X_out)**2 + min(Y_in,Y_out)**2)
else
r=0.0
end if
if ( r < 1 )then
if ( j <= i )then
sum_A = sum_A + sin(angle(j));
sum_B = sum_B + cos(angle(j));
else
sum_A = sum_A + alpha*sin(angle(j));
sum_B = sum_B + alpha*cos(angle(j));
endif
n_p = n_p + 1;
endif
enddo
enddo
sum_A = sum_A/n_p; sum_B = sum_B/n_p
!if (int(sum_A*1e10) ==0 .and. int(sum_B*1e10) ==0 )print*,'zerrooo'
avrage_t=atan2(sum_A,sum_B);
if (avrage_t<0.0) then
avrage_t=avrage_t+2.0*pi;
endif
call random_number(ra)
angle_new(i)=avrage_t+eta*(ra-0.50)
if( angle_new(i)>=2*pi) angle_new(i)= angle_new(i)-2*pi
if( angle_new(i)<0) angle_new(i)= 2*pi+angle_new(i)
end do
!$OMP END DO
!$OMP END PARALLEL
angle = angle_new
C(:,:)%partical_N=0
! phi=0.0
do i=1, N
x(i) = x(i) + v0*sin(angle(i));
if (x(i)<1) x(i)=L+x(i)
if (x(i)>L) x(i)=x(i)-L
I_b = int(x(i))+1
y(i) = y(i)+ v0*cos(angle(i));
if (y(i)<1) y(i)=L+y(i)
if (y(i)>L) y(i)=y(i)-L
J_b = int(y(i))+1
C(I_b,J_b)%partical_N = C(I_b,J_b)%partical_N + 1
C(I_b,J_b)%particle_ad( C(I_b,J_b)%partical_N ) = i
end do
if (stateta == 1 )then
phi= sqrt((sum(sin(angle))**2+sum(cos(angle))**2))/N;
ot = ot + 1
end if
write(10,*)phi
if (mod(t,10)==0)then
! ave4_phi=sum(phi**4)/t;
! ave2_phi =sum(phi**2)/t;
!print* ,ave4_phi,ave2_phi
print*,'Time=',t,' ==== Eta : ',eta,"Ot : " , ot
end if
end do
END_1 = omp_get_wtime()
print*,'Run Time = ',end_1-start
End Program
P.S.(1) : I use omp lib to run my program parallel
P.S.(2) : I use gfortran to compile the code
P.S.(3) : Code compiled with -g -fcheck=all and gives me this error :
At line 155 of file z.f90 Fortran runtime error: Index '1281' of dimension 1 of array 'c%particle_ad' above upper bound of 1280
Thanks to you all
Your particle_ad arrays only have space for 10*L particles, but you appear to be trying to store up to N=2*L**2 particles in them (depending on how the random numbers fall). On average, each will have enough space, but your code will fail if too many particles fall into a single block, and (if I'm remembering the probabilities right) the chances of this happening increase as L increases.
You could solve this problem by replacing Integer :: particle_ad(10*L) with Integer :: particle_ad(N), but this will waste an awful lot of space.
A better solution would be to re-size the particle_ad arrays on the fly, making them bigger every time they get full. For convenience, you could wrap this behaviour in a method of the block_p class.
For example,
type block_p
Integer :: partical_N
Integer, allocatable :: particle_ad(:)
contains
subroutine add_particle(this, index)
class(block_p), intent(inout) :: this
integer, intent(in) :: index
integer, allocatable :: temp
! Update partical_N.
this%partical_N = this%partical_N + 1
! Resize particle_ad if it is full.
if (size(this%particle_ad)<this%partical_N) then
temp = this%particle_ad
deallocate(this%particle_ad)
allocate(this%particle_ad(2*this%partical_N))
this%particle_ad(:size(temp)) = temp
endif
! Add the new index to particle_ad.
this%particle_ad(this%partical_N) = index
end subroutine
end type
You could then replace the lines
C(I_b,J_b)%partical_N = C(I_b,J_b)%partical_N + 1
C(I_b,J_b)%particle_ad( C(I_b,J_b)%partical_N ) = i
with
call C(I_b,J_b)%add_particle(i)
Note that as each particle_ad array is now allocatable, you will need to initialise each array before you can call add_particle.
I am getting an error while I run this code. When I run the code with small L's like L=16 or L=32 I get no error but in L = 128 or L=96 after 7000-8000 steps I get following error :
Program received signal SIGSEGV: Segmentation fault - invalid memory reference.
Backtrace for this error:
#0 0x7FBA5CAC3E08
#1 0x7FBA5CAC2F90
#2 0x7FBA5C1E84AF
#3 0x402769 in MAIN__ at newhys.f90:?
Segmentation fault (core dumped)
This is the full code :
SUBROUTINE init_random_seed()
implicit none
INTEGER :: i, n, clock
INTEGER, DIMENSION(:), ALLOCATABLE :: seed
CALL RANDOM_SEED(size = n)
ALLOCATE(seed(n))
CALL SYSTEM_CLOCK(COUNT=clock)
seed = clock + 37 * (/ (i - 1, i = 1, n) /)
CALL RANDOM_SEED(PUT = seed)
DEALLOCATE(seed)
END SUBROUTINE
!end module
Program Activ_mater
USE OMP_LIB
Implicit none
Integer,parameter :: time=1000000000, L=128, N = L**2*2
Integer,parameter:: n_thread = 8
Real(8),parameter :: pi = 3.14159265359
Real(8),parameter :: v0 = 0.50, alpha = 1.0/36.0
real(8)START,END_1 ,eta
type block_p
Integer :: partical_N
Integer :: particle_ad(10*L)
end type
Type(block_p) ,pointer,dimension(:,:) :: C
Real(8),allocatable :: x(:), y(:) , phi,angle_new(:),angle(:)
Real(8) :: sum_a, sum_b,x_in, y_in, x_out, y_out, avrage_t, r,ra,eta1(5)
Integer :: i,j,t,n_p,I_b,J_b,b_l,neighbor_i(9),neighbor_j(9),A,n_p_b,ne = 1,stateta=0,ot=0,op=175
character(len=10)::name1
call omp_set_num_threads(n_thread)
call init_random_seed()
eta1=(/2.100,2.116,2.120,2.126,2.128/) ! The value of ETA
allocate(x(2*n), y(2*n) , phi,angle_new(2*N),angle(2*N))
allocate(C(2*L,2*L))
C(:,:)%partical_N=0
do i =1,N
call random_number(ra)
x(i)=ra*L
I_b = int(x(i))+1
call random_number(ra)
y(i)=ra*L
J_b = int(y(i))+1
call random_number(ra)
angle(i)=ra*2.0*pi
C(I_b,J_b)%partical_N = C(I_b,J_b)%partical_N + 1 !Number of particle in block C(I_b,J_b)
C(I_b,J_b)%particle_ad( C(I_b,J_b)%partical_N ) = i ! The particle number in block C(I_b,J_b)
end do
! loop for eta
eta= 0.0
write(name1,'(f5.3)')eta
open(unit=10, file='Hysteresis,'//trim(name1)//'.dat')
!=====================explanation of system====================================
print*,'==========================================================================='
print*, 'eta = ', etA ,' ',' alpha = ',alpha
print*,'L=',L ,' ', 'Particle Number=', N,' ','Density=', N/L**2
print*,'==========================================================================='
!==============================================================================
START = omp_get_wtime()
do t =1,time
if (ot == 300000 )then
stateta = 0
ot = 0
op = op + 1
end if
if (stateta == 0 )then
eta = eta + ((1.0/3.0) * (10E-6))
endif
if (int(eta * 100) == op) then
stateta = 1
end if
angle_new(:)=0
!$OMP PARALLEL DEFAULT(PRIVATE) SHARED(x,y,angle,angle_new,c) firstprivate(eta)
!$OMP DO schedule(runtime)
do i =1, N
sum_a=0; sum_b=0;n_p=0
I_b = int(x(i))+1; J_b = int(y(i))+1 ! The block of particle i
! Now I should find nine neighbor of particle i-----------------------------------------------
neighbor_i=(/I_b+1, I_b, I_b-1, I_b, I_b+1, I_b-1, I_b-1, I_b+1, I_b/)
neighbor_j=(/J_b, J_b+1, J_b, J_b-1, J_b+1, J_b+1, J_b-1, J_b-1, J_b/)
do b_l = 1, 9
I_b = neighbor_i(b_l) ; J_b=neighbor_j(b_l)
if (I_b >L )I_b=1
if (I_b <1 )I_b=L
if (J_b >L )J_b=1
if (J_b <1 )J_b=L
!neighbor_i(b_l)=I_b; neighbor_j(b_l)=J_b
A = C( I_b, J_b )%partical_N ! number of particle in block C( neighbor_i(b_l), neighbor_j(b_l) )
!=============================================================================================
do n_p_b =1, A
j = C( I_b, J_b)%particle_ad(n_p_b) !particle j in the block C
if (i /= j )then
X_in = abs(max(x(i),x(j)) - min(x(i),x(j)));
Y_in = abs(max(y(i),y(j)) - min(y(i),y(j)));
X_out =L-X_in
Y_out =L-Y_in
r = sqrt(min(X_in,X_out)**2 + min(Y_in,Y_out)**2)
else
r=0.0
end if
if ( r < 1 )then
if ( j <= i )then
sum_A = sum_A + sin(angle(j));
sum_B = sum_B + cos(angle(j));
else
sum_A = sum_A + alpha*sin(angle(j));
sum_B = sum_B + alpha*cos(angle(j));
endif
n_p = n_p + 1;
endif
enddo
enddo
sum_A = sum_A/n_p; sum_B = sum_B/n_p
!if (int(sum_A*1e10) ==0 .and. int(sum_B*1e10) ==0 )print*,'zerrooo'
avrage_t=atan2(sum_A,sum_B);
if (avrage_t<0.0) then
avrage_t=avrage_t+2.0*pi;
endif
call random_number(ra)
angle_new(i)=avrage_t+eta*(ra-0.50)
if( angle_new(i)>=2*pi) angle_new(i)= angle_new(i)-2*pi
if( angle_new(i)<0) angle_new(i)= 2*pi+angle_new(i)
end do
!$OMP END DO
!$OMP END PARALLEL
angle = angle_new
C(:,:)%partical_N=0
! phi=0.0
do i=1, N
x(i) = x(i) + v0*sin(angle(i));
if (x(i)<1) x(i)=L+x(i)
if (x(i)>L) x(i)=x(i)-L
I_b = int(x(i))+1
y(i) = y(i)+ v0*cos(angle(i));
if (y(i)<1) y(i)=L+y(i)
if (y(i)>L) y(i)=y(i)-L
J_b = int(y(i))+1
C(I_b,J_b)%partical_N = C(I_b,J_b)%partical_N + 1
C(I_b,J_b)%particle_ad( C(I_b,J_b)%partical_N ) = i
end do
if (stateta == 1 )then
phi= sqrt((sum(sin(angle))**2+sum(cos(angle))**2))/N;
ot = ot + 1
end if
write(10,*)phi
if (mod(t,10)==0)then
! ave4_phi=sum(phi**4)/t;
! ave2_phi =sum(phi**2)/t;
!print* ,ave4_phi,ave2_phi
print*,'Time=',t,' ==== Eta : ',eta,"Ot : " , ot
end if
end do
END_1 = omp_get_wtime()
print*,'Run Time = ',end_1-start
End Program
P.S.(1) : I use omp lib to run my program parallel
P.S.(2) : I use gfortran to compile the code
P.S.(3) : Code compiled with -g -fcheck=all and gives me this error :
At line 155 of file z.f90 Fortran runtime error: Index '1281' of dimension 1 of array 'c%particle_ad' above upper bound of 1280
Thanks to you all
Your particle_ad arrays only have space for 10*L particles, but you appear to be trying to store up to N=2*L**2 particles in them (depending on how the random numbers fall). On average, each will have enough space, but your code will fail if too many particles fall into a single block, and (if I'm remembering the probabilities right) the chances of this happening increase as L increases.
You could solve this problem by replacing Integer :: particle_ad(10*L) with Integer :: particle_ad(N), but this will waste an awful lot of space.
A better solution would be to re-size the particle_ad arrays on the fly, making them bigger every time they get full. For convenience, you could wrap this behaviour in a method of the block_p class.
For example,
type block_p
Integer :: partical_N
Integer, allocatable :: particle_ad(:)
contains
subroutine add_particle(this, index)
class(block_p), intent(inout) :: this
integer, intent(in) :: index
integer, allocatable :: temp
! Update partical_N.
this%partical_N = this%partical_N + 1
! Resize particle_ad if it is full.
if (size(this%particle_ad)<this%partical_N) then
temp = this%particle_ad
deallocate(this%particle_ad)
allocate(this%particle_ad(2*this%partical_N))
this%particle_ad(:size(temp)) = temp
endif
! Add the new index to particle_ad.
this%particle_ad(this%partical_N) = index
end subroutine
end type
You could then replace the lines
C(I_b,J_b)%partical_N = C(I_b,J_b)%partical_N + 1
C(I_b,J_b)%particle_ad( C(I_b,J_b)%partical_N ) = i
with
call C(I_b,J_b)%add_particle(i)
Note that as each particle_ad array is now allocatable, you will need to initialise each array before you can call add_particle.
implicit none
character*20 fflname,oflname
integer length_sgnl
real*8 pi, dt, m, n, theta
parameter ( length_sgnl=11900, dt=0.01d0, m=1, n=1, pi=3.1416
& ,theta=0.2 )
integer i
complex*16 cj, coeff ,sgnl(1 : length_sgnl)
real*8 t(1 : length_sgnl)
parameter ( cj = dcmplx(0, 1) )
real*8 time, real_sgnl, imag_sgnl
oflname="filtered.data"
fflname="artificial"
open(11, file = oflname)
do i=1, length_sgnl
read(11, *) time, real_sgnl, imag_sgnl
sgnl(i) = dcmplx(real_sgnl, imag_sgnl)
t(i) = (i*dt - m) / (2**n)
enddo
coeff = 0
do i=1, length_sgnl
coeff = coeff
& + sgnl(i) * sinc (t(i)) * exp (-cj*2*pi*t(i))
enddo
do i=1, length_sgnl
sgnl(i) = sgnl(i)
& - coeff * sinc (t(i)) * exp (-cj*2*pi*t(i))
& + coeff * sinc (t(i)) * exp (-cj*2*pi*t(i))
& * exp (cj*theta)
enddo
open(12, file = fflname)
do i=1, length_sgnl
write(12, *) i*dt, sgnl(i)
enddo
close(12)
real*8 function sinc (a)
real*8 :: sinc, a
if (abs(a) < 1.0d-6) then
sinc = 1
else
sinc = sin(pi*a) / (pi*a)
end if
end function
stop
end
At the last part of a sub-defined function sinc, I assume the problem is there but I am not sure what it is exactly. The gfortran noticed that I did not define sinc and a, and the "end function" should be "end program"?
I have tried to update your program into standards-compliant modern Fortran:
program sinctest
use :: iso_fortran_env
implicit none
! Declare parameters
integer, parameter :: length_sgnl=11900
real(real64), parameter :: pi=3.1416, dt=0.01, m=1, n=1, theta=0.2
complex(real64), parameter :: cj = cmplx(0, 1)
! Declare variables
character(len=20) :: fflname, oflname
complex(real64) :: coeff, sgnl(length_sgnl)
real(real64) :: time, real_sgnl, imag_sgnl, t(length_sgnl)
integer :: i, ofl, ffl
! Define filenames
oflname="filtered.data"
fflname="artificial"
! Read the input file
open(newunit = ofl, file = oflname)
do i=1, length_sgnl
read(ofl, *) time, real_sgnl, imag_sgnl
sgnl(i) = cmplx(real_sgnl, imag_sgnl, kind=real64)
t(i) = (i*dt - m) / (2**n)
end do
close(ofl)
! Process the input signal
coeff = 0
do i=1, length_sgnl
coeff = coeff &
+ sgnl(i) * sinc(t(i)) * exp(-cj*2*pi*t(i))
end do
do i=1, length_sgnl
sgnl(i) = sgnl(i) &
- coeff * sinc(t(i)) * exp(-cj*2*pi*t(i)) &
+ coeff * sinc(t(i)) * exp(-cj*2*pi*t(i)) &
* exp(cj*theta)
end do
! Save the output file
open(newunit = ffl, file = fflname)
do i=1, length_sgnl
write(ffl, *) i*dt, sgnl(i)
enddo
close(ffl)
contains
pure function sinc(a) result(r)
! This function calculates sinc(a)=sin(pi*a)/(pi*a).
real(real64), intent(in) :: a
real(real64) :: r
if (abs(a) < 1.0e-6) then
r = 1
else
r = sin(pi*a) / (pi*a)
end if
end function
end program
To compile it using e.g. GFortran:
gfortran -std=f2008 -ffree-form sinctest.f
These are the syntax errors that I fixed:
Added a contains section before defining your sinc-function;
Moved your continuation characters (&) from the beginning of a continued line to the end of the previous line;
These are not required changes, just merely style suggestions:
Used the intrinsic module iso_fortran_env to get the real64 variable, which lets you define variables as real(real64) instead of real*8, as the former is portable while the latter is not;
Merged the specification of the variable type (e.g. real) and parameter into a single lines;
Used the Fortran2008 newunit argument to open instead of hard-coding in unit numbers, as this saves you some headache if you write large programs and have a modern compiler;
Made sure that you close the input file as well;
Declared your sinc-function to be pure, as it has no side-effects;
Used the result notation for your sinc-function, so that you don't have to specify the type real*8 in front of the function name;
Rewrote the program in the form program...end program instead of ...stop end.
EDIT:
I also wanted to note that using modern Fortran, the math itself can be written considerably more consise using 'array notation' and 'elemental functions'. For instance, if you define your sinc-function:
elemental function sinc(a) result(r)
! This function calculates sinc(a)=sin(pi*a)/(pi*a).
real(real64), intent(in) :: a
real(real64) :: r
if (abs(a) < 1.0e-6) then
r = 1
else
r = sin(pi*a) / (pi*a)
end if
end function
Then the elemental keyword says that if you apply the sinc-function to an array, it should return a new array where the sinc-function has been evaluated for each element. So this piece of code:
coeff = 0
do i=1, length_sgnl
coeff = coeff &
+ sgnl(i) * sinc(t(i)) * exp(-cj*2*pi*t(i))
end do
Can then actually be written as a one-liner:
coeff = sum(sgnl * sinc(t) * exp(-2*pi*cj*t))
So I would highly recommend that you look into the modern array notation too :).
EDIT 2:
Tried to emphasize what changes are relevant to fixing errors, and what changes are just style suggestions (thanks Vladimir F).
I have been writing a script in fortran 90 for solving the radial oscillation problem of a neutron star with the use of shooting method. But for unknown reason, my program never works out. Without the shooting method component, the program runs smoothly as it successfully constructed the star. But once the shooting comes in, everything dies.
PROGRAM ROSCILLATION2
USE eos_parameters
IMPLICIT NONE
INTEGER ::i, j, k, l
INTEGER, PARAMETER :: N_ode = 5
REAL, DIMENSION(N_ode) :: y
REAL(8) :: rho0_cgs, rho0, P0, r0, phi0, pi
REAL(8) :: r, rend, mass, P, phi, delta, xi, eta
REAL(8) :: step, omega, omegastep, tiny, rho_print, Radius, B, a2, s0, lamda, E0, E
EXTERNAL :: fcn
!!!! User input
rho0_cgs = 2.D+15 !central density in cgs unit
step = 1.D-4 ! step size dr
omegastep = 1.D-2 ! step size d(omega)
tiny = 1.D-8 ! small number P(R)/P(0) to define star surface
!!!!!!!!!
open(unit=15, file="data.dat", status="new")
pi = ACOS(-1.D0)
a2 =((((1.6022D-13)**4)*(6.674D-11)*((2.997D8)**-7)*((1.0546D-34)**-3)*(1.D6))**(0.5D0))*a2_MeV !convert to code unit (km^-1)
B = ((1.6022D-13)**4)*(6.674D-11)*((2.997D8)**-7)*((1.0546D-34)**-3)*(1.D6)*B_MeV !convert to code unit (km^-2)
s0 = (1.D0/3.D0) - (1/(6*pi**2))*a2*((1/(16*pi**2)*a2**2 + (pi**-2)*a4*(rho0 - B))**-0.5) !square of the spped of sound at r=0
lamda = -0.5D0*log(1-2*y(1)/r)
E0 = (r0**-2)*s0*exp(lamda + 3*phi0)
rho0 = rho0_cgs*6.67D-18 / 9.D0 !convert rho0 to code unit (km^-2)
!! Calculate central pressure P0
P0 = (1.D0/3.D0)*rho0 - (4.D0/3.D0)*B - (1.D0/(a4*(12.D0)*(pi**2)))*a2**2 - &
&(a2/((3.D0)*a4))*(((1.D0/(16.D0*pi**4))*a2**2+(1.D0/(pi**2))*a4*(rho0-B))**0.5D0)
!! initial value for metric function phi
phi0 = 0.1D0 ! arbitrary (needed to be adjusted later)
r0 = 1.D-30 ! integration starting point
!! Set initial conditions
!!!!!!!!!!!!!!!!!
!!Start integration loop
!!!!!!!!!!!!!!!!!
r = r0
y(1) = 0.D0
y(2) = P0
y(3) = phi0
y(4) = 1/(3*E0)
y(5) = 1
omega = 2*pi*1000/(2.997D5) !omega of 1kHz in code unit
DO l = 1, 1000
omega = omega + omegastep !shooting method part
DO i = 1, 1000000000
rend = r0 + REAL(i)*step
call oderk(r,rend,y,N_ode,fcn)
r = rend
mass = y(1)
P = y(2)
phi = y(3)
xi = y(4)
eta = y(5)
IF (P < tiny*P0) THEN
WRITE(*,*) "Central density (10^14 cgs) = ", rho0_cgs/1.D14
WRITE(*,*) " Mass (solar mass) = ", mass/1.477D0
WRITE(*,*) " Radius (km) = ", r
WRITE(*,*) " Compactness M/R ", mass/r
WRITE(15,*) (omega*2.997D5/(2*pi)), y(5)
GOTO 21
ENDIF
ENDDO
ENDDO
21 CONTINUE
END PROGRAM roscillation2
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
SUBROUTINE fcn(r,y,yprime)
USE eos_parameters
IMPLICIT NONE
REAL(8), DIMENSION(5) :: y, yprime
REAL(8) :: r, m, P, phi, rho, pi, B, a2, xi, eta, W, Q, E, s, lamda, omega
INTEGER :: j
pi = ACOS(-1.D0)
a2 =((((1.6022D-13)**4)*(6.674D-11)*((2.997D8)**-7)*((1.0546D-34)**-3)*(1.D6))**(0.5D0))*a2_MeV !convert to code unit (km^-1)
B = ((1.6022D-13)**4)*(6.674D-11)*((2.997D8)**-7)*((1.0546D-34)**-3)*(1.D6)*B_MeV !convert to code unit (km^-2)
m = y(1)
P = y(2)
phi = y(3)
xi = y(4)
eta = y(5)
rho = 3.D0*P + 4.D0*B +((3.D0)/(4.D0*a4*(pi**2)))*a2**2+(a2/a4)*&
&(((9.D0/((16.D0)*(pi**4)))*a2**2+((3.D0/(pi**2))*a4*(P+B)))**0.5D0)
s = (1.D0/3.D0) - (1/(6*pi**2))*a2*((1/(16*pi**2)*a2**2 + (pi**-2)*a4*(rho - B))**-0.5) !square of speed of sound
W = (r**-2)*(rho + P)*exp(3*lamda + phi)
E = (r**-2)*s*exp(lamda + 3*phi)
Q = (r**-2)*exp(lamda + 3*phi)*(rho + P)*((yprime(3)**2) + 4*(r**-1)*yprime(3)- 8*pi*P*exp(2*lamda))
yprime(1) = 4.D0*pi*rho*r**2
yprime(2) = - (rho + P)*(m + 4.D0*pi*P*r**3)/(r*(r-2.D0*m))
yprime(3) = (m + 4.D0*pi*P*r**3)/(r*(r-2.D0*m))
yprime(4) = y(5)/(3*E)
yprime(5) = -(W*omega**2 + Q)*y(4)
END SUBROUTINE fcn
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!
!! Runge-Kutta method (from Numerical Recipes)
!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine oderk(ri,re,y,n,derivs)
INTEGER, PARAMETER :: NMAX=16
REAL(8) :: ri, re, step
REAL(8), DIMENSION(NMAX) :: y, dydx, yout
EXTERNAL :: derivs,rk4
call derivs(ri,y,dydx)
step=re-ri
CALL rk4(y,dydx,n,ri,step,yout,derivs)
do i=1,n
y(i)=yout(i)
enddo
return
end subroutine oderk
SUBROUTINE RK4(Y,DYDX,N,X,H,YOUT,DERIVS)
INTEGER, PARAMETER :: NMAX=16
REAL(8) :: H,HH,XH,X,H6
REAL(8), DIMENSION(N) :: Y, DYDX, YOUT
REAL(8), DIMENSION(NMAX) :: YT, DYT, DYM
EXTERNAL :: derivs
HH=H*0.5D0
H6=H/6D0
XH=X+HH
DO I=1,N
YT(I)=Y(I)+HH*DYDX(I)
ENDDO
CALL DERIVS(XH,YT,DYT)
DO I=1,N
YT(I)=Y(I)+HH*DYT(I)
ENDDO
CALL DERIVS(XH,YT,DYM)
DO I=1,N
YT(I)=Y(I)+H*DYM(I)
DYM(I)=DYT(I)+DYM(I)
ENDDO
CALL DERIVS(X+H,YT,DYT)
DO I=1,N
YOUT(I)=Y(I)+H6*(DYDX(I)+DYT(I)+2*DYM(I))
ENDDO
END SUBROUTINE RK4
Any reply would be great i am just really depressed for the long debugging.
Your program is blowing up because of this line:
yprime(5) = -(W*omega**2 + Q)*y(4)
in subroutine fcn. In this subroutine, omega is completely independent of the one declared in your main program. This one is uninitialized and used in an expression, which will either contain random values or zero, if your compiler is nice enough (or told) to initialize variables.
If you want the variable omega from your main program to be the same variable you use in fcn then you need to pass that variable to fcn somehow. Due to the way you've architected this program, passing it would require modifying all of your procedures to pass omega so that it can be provided to all of your calls to DERIVS (which is the dummy argument you are associating with fcn).
An alternative would be to put omega into a module and use that module where you need access to omega, e.g. declare it in eos_parameters instead of declaring it in the scoping units of fcn and your main program.
I have written the following code in F2003, trying to
implement an adaptive trapezoid method and adaptive
simpson's rule method for simple integrals and I am
having seg fault problems when I try to run the code using
intrinsic functions (exp, log, sin) but it works perfectly for
polynomials (x ** 2, for instance).
I have compiled like this:
$ gfortran -Wall -pedantic -fbounds-check integral_module.f03 integrate.f03 -o integral
And I get no warnings.
Any ideas??
integral_module.f03
module integral_module
implicit none
public :: integral
!To test which is more efficient
integer, public :: counter_int = 0, counter_simpson = 0
contains
recursive function integral(f, a, b, tolerance) &
result(integral_result)
intrinsic :: abs
interface
function f(x) result(f_result)
real, intent(in) :: x
real :: f_result
end function f
end interface
real, intent(in) :: a, b, tolerance
real :: integral_result
real :: h, mid
real :: trapezoid_1, trapezoid_2
real :: left_area, right_area
counter_int = counter_int + 1
h = b - a
mid = (a + b) / 2
trapezoid_1 = h * (f(a) + f(b)) / 2.0
trapezoid_2 = h / 2 * (f(a) + f(mid)) / 2.0 + &
h / 2 * (f(mid) + f(b)) / 2.0
if(abs(trapezoid_1 - trapezoid_2) < 3.0 * tolerance) then
integral_result = trapezoid_2
else
left_area = integral(f, a, mid, tolerance / 2)
right_area = integral(f, mid, b, tolerance / 2)
integral_result = left_area + right_area
end if
end function integral
recursive function simpson(f, a, h, tolerance) &
result(simpson_result)
intrinsic :: abs
interface
function f(x) result(f_result)
real, intent(in) :: x
real :: f_result
end function f
end interface
real, intent(in) :: a, h, tolerance
real :: simpson_result
real :: h_half, a_lower, a_upper
real :: parabola_1, parabola_2
real :: left_area, right_area
counter_simpson = counter_simpson + 1
h_half = h / 2.0
a_lower = a - h_half
a_upper = a + h_half
parabola_1 = h / 3.0 * (f(a - h) + 4.0 * f(a) + f(a + h))
parabola_2 = h_half / 3.0 * (f(a_lower - h_half) + 4.0 * f(a_lower) + f(a_lower + h_half)) + &
h_half / 3.0 * (f(a_upper - h_half) + 4.0 * f(a_upper) + f(a_upper + h_half))
if(abs(parabola_1 - parabola_2) < 15.0 * tolerance) then
simpson_result = parabola_2
else
left_area = simpson(f, a_lower, h_half, tolerance / 2.0)
right_area = simpson(f, a_upper, h_half, tolerance / 2.0)
simpson_result = left_area + right_area
end if
end function simpson
end module integral_module
And, integrate.f03
module function_module
implicit none
public :: non_para_errfun, parabola
contains
function non_para_errfun(x) result(errfun_result)
real, intent(in) :: x
real :: errfun_result
intrinsic :: exp
errfun_result = exp(x ** 2.0)
end function non_para_errfun
function parabola(x) result(parabola_result)
real, intent(in) :: x
real :: parabola_result
parabola_result = x ** 2.0
end function parabola
function brainerd(x) result(brainerd_result)
real, intent(in) :: x
real :: brainerd_result
intrinsic :: exp, sin
brainerd_result = exp(x ** 2.0) + sin(2.0 * x)
end function brainerd
end module function_module
module math_module
implicit none
intrinsic :: atan
real, parameter, public :: pi = &
4.0 * atan(1.0)
end module math_module
program integrate
use function_module, f => brainerd
use integral_module
use math_module, only : pi
implicit none
intrinsic :: sqrt, abs
real :: x_min, x_max, a, h, ans, ans_simpson
real, parameter :: tolerance = 0.01
x_min = 0
x_max = 2.0 * pi
a = abs(x_max) - abs(x_min)
h = (abs(x_max) + abs(x_min)) / 2.0
!ans = integral(f, x_min, x_max, tolerance)
ans_simpson = simpson(f, a, h, tolerance)
!print "(a, f11.6)", &
! "The integral is approx. ", ans
print "(a, f11.6)", &
"The Simpson Integral is approx: ", ans_simpson
!print "(a, f11.6)", &
! "The exact answer is ", &
! 1.0/3.0 * x_max ** 3 - 1.0/3.0 * x_min ** 3
print *
!print "(a, i5, a)", "The trapezoid rule was executed ", counter_int, " times."
print "(a, i5, a)", "The Simpson's rule was executed ", counter_simpson, " times."
end program integrate
You are getting a floating point exception when executing exp(x ** 2.0), since round about x > 9.35 the exponent gets too large for single precision floats.
Switching to double precision gets rid of the overflow.
You'd also want to change the x ** 2.0 to x**2, s.t. the compiler can optimize the integer power instead of doing the much more costly floating point operation.