I want to do an iteration of the strain and stress change in rock mechanics, but am stuck on the errors:
"real::STRAIN (1:N), SIGMA (1:N),DSIGMA (1:N),STRAIN (1:N)=0.0"
and
"real,Dimension(6)::CEL(1:N,1:N)!stiffness matrix"
!program elastic_plastic
implicit none
!define all parameter
integer :: i = 1.0,j,K,M,N,inc
real::STRAIN (1:N), SIGMA (1:N),DSIGMA (1:N),DSTRAIN (1:N)=0.0
real,Dimension(6)::CEL(1:N,1:N)!stiffness matrix
real:: YOUNG, NU, COHESION !rock properties
real::ALPHA, KAPPA! cohesion and frictional angle
real::F !function
real::FRICTION_DEG, FRICTION_RAD !friction angle
real::VARJ2 ,VARI1 !stress invariants (I1 and J2)(MPa)
real:: LAMBDA,GMODU !lames constant and shear modulus
real::SIGMA_1,SIGMA_2,SIGMA_3 !principle stresses(MPa)
real::SHEAR_4,SHEAR_5,SHEAR_6 !shear stresses
real,parameter::DEG_2_RAD = 0.01745329
!INPUT
NU = 0.25
COHESION = 15 ! in MPa
YOUNG = 20 ! in GPa
FRICTION_DEG = 30.0d0
FRICTION_RAD = FRICTION_DEG *(DEG_2_RAD)
!perform calculations
KAPPA=6.*COHESION *cos(FRICTION_DEG*DEG_2_RAD)/(sqrt(3.)*(3.-sin(FRICTION_DEG*DEG_2_RAD)))
ALPHA=2.*sin(FRICTION_DEG*DEG_2_RAD)/(sqrt(3.)*(3.-sin(FRICTION_DEG*DEG_2_RAD)))
GMODU=YOUNG/2.*(1.+NU)
LAMBDA=NU*YOUNG/((1.+NU)*(1.-(2.*NU)))
!Set up elastic stiffness matrix (CEL)
CEL(1:N,1:N)=0.0
CEL (1,1)= LAMBDA-(2.*GMODU)
CEL (2,2)= LAMBDA-(2.*GMODU)
CEL (3,3)= LAMBDA-(2.*GMODU)
CEL (4,4)= 2.*GMODU
CEL (5,5)= 2.*GMODU
CEL (6,6)= 2.*GMODU
DO
inc = inc + 1
DSTRAIN(1)=0.00002
DSIGMA = matmul (CEL(1:N,1:N), DSTRAIN)
SIGMA =SIGMA +DSIGMA
STRAIN=STRAIN+DSTRAIN
!calculate I1 AND J2
VARI1=SIGMA_1+SIGMA_2+SIGMA_3
VARJ2=1./6.*((SIGMA_1-SIGMA_2)**2+(SIGMA_2-SIGMA_3)**2+(SIGMA_3- SIGMA_1)**2+SHEAR_4**2+SHEAR_5**2+SHEAR_6**2)
!Yield function (Drucker-prager)
F= ALPHA*VARI1+(sqrt(VARJ2)-KAPPA)
IF (F.LE.0.0d0)then !Elastic step (exit)
SIGMA =SIGMA
STRAIN=STRAIN
exit
endif
if (F.GT.0.0d0)then !Plastic step (continue)
goto 20
end if
20 continue
write(11,*)STRAIN,SIGMA,inc
END DO
end
You can't statically define an array with a variable. You must use a constant.
For example the following will work:
real::STRAIN (1:5), SIGMA (1:5),DSIGMA (1:5),DSTRAIN (1:5)=0.0
real,Dimension(6)::CEL(1:5,1:5)!stiffness matrix
If you don't know the size of the arrays at code time you can use the 'allocate' statement. This is known as 'dynamic storage allocation'. From 'Arrays and Parallel programming in Fortran 90/95':
The way to declare an allocatable array is as follows:
integer Nparticles ! number of particles
integer, parameter :: dim=3 ! dimensionality of space
...
real, allocatable :: charge(:) ! defines an array containing the charge of
! each particle
integer, allocatable :: xyz(:,:) ! coordinates of each particle
Once the actual number of particles in the simulation has been read, we can allocate these arrays:
read(*,*) Nparticles
allocate (charge(Nparticles),xyz(dim,Nparticles))
Related
In Newton's method, to solve a nonlinear system of equations we need to find the Jacobian matrix and the determinant of the inverse of the Jacobian matrix.
Here are my component functions,
real function f1(x,y)
parameter (pi = 3.141592653589793)
f1 = log(abs(x-y**2)) - sin(x*y) - sin(pi)
end function f1
real function f2(x,y)
f2 = exp(x*y) + cos(x-y) - 2
end function f2
For the 2x2 case I am computing the Jacobian matrix and determinant of the inverse of Jacobian matrix like this,
x = [2,2]
h = 0.00001
.
.
! calculate approximate partial derivative
! you can make it more accurate by reducing the
! value of h
j11 = (f1(x(1)+h,x(2))-f1(x(1),x(2)))/h
j12 = (f1(x(1),x(2)+h)-f1(x(1),x(2)))/h
j21 = (f2(x(1)+h,x(2))-f2(x(1),x(2)))/h
j22 = (f2(x(1),x(2)+h)-f2(x(1),x(2)))/h
! calculate the Jacobian
J(1,:) = [j11,j12]
J(2,:) = [j21,j22]
! calculate inverse Jacobian
inv_J(1,:) = [J(2,2),-J(1,2)]
inv_J(2,:) = [-J(2,1),J(1,1)]
DET=J(1,1)*J(2,2) - J(1,2)*J(2,1)
inv_J = inv_J/DET
.
.
How do I in Fortran extend this to evaluate a Jacobian for m functions evaluated at n points?
Here is a more flexible jacobian calculator.
The results with the 2×2 test case are what you expect
arguments (x)
2.00000000000000
2.00000000000000
values (y)
1.44994967586787
53.5981500331442
Jacobian
0.807287239448229 3.30728724371454
109.196300248300 109.196300248300
I check the results against a symbolic calculation for the given inputs of
Console.f90
program Console1
use ISO_FORTRAN_ENV
implicit none
! Variables
integer, parameter :: wp = real64
real(wp), parameter :: pi = 3.141592653589793d0
! Interfaces
interface
function fun(x,n,m) result(y)
import
integer, intent(in) :: n,m
real(wp), intent(in) :: x(m)
real(wp) :: y(n)
end function
end interface
real(wp) :: h
real(wp), allocatable :: x(:), y(:), J(:,:)
! Body of Console1
x = [2d0, 2d0]
h = 0.0001d0
print *, "arguments"
print *, x(1)
print *, x(2)
y = test(x,2,2)
print *, "values"
print *, y(1)
print *, y(2)
J = jacobian(test,x,2,h)
print *, "Jacobian"
print *, J(1,:)
print *, J(2,:)
contains
function test(x,n,m) result(y)
! Test case per original question
integer, intent(in) :: n,m
real(wp), intent(in) :: x(m)
real(wp) :: y(n)
y(1) = log(abs(x(1)-x(2)**2)) - sin(x(1)*x(2)) - sin(pi)
y(2) = exp(x(1)*x(2)) + cos(x(1)-x(2)) - 2
end function
function jacobian(f,x,n,h) result(u)
procedure(fun), pointer, intent(in) :: f
real(wp), allocatable, intent(in) :: x(:)
integer, intent(in) :: n
real(wp), intent(in) :: h
real(wp), allocatable :: u(:,:)
integer :: j, m
real(wp), allocatable :: y1(:), y2(:), e(:)
m = size(x)
allocate(u(n,m))
do j=1, m
e = element(j, m) ! Get kronecker delta for j-th value
y1 = f(x-e*h/2,n,m)
y2 = f(x+e*h/2,n,m)
u(:,j) = (y2-y1)/h ! Finite difference for each column
end do
end function
function element(i,n) result(e)
! Kronecker delta vector. All zeros, except the i-th value.
integer, intent(in) :: i, n
real(wp) :: e(n)
e(:) = 0d0
e(i) = 1d0
end function
end program Console1
I will answer about evaluation in different points. This is quite simple. You just need an array of points, and if the points are in some regular grid, you may not even need that.
You may have an array of xs and array of ys or you can have an array of derived datatype with x and y components.
For the former:
real, allocatable :: x(:), y(:)
x = [... !probably read from some data file
y = [...
do i = 1, size(x)
J(i) = Jacobian(f, x(i), y(i))
end do
If you want to have many functions at the same time, the problem is always in representing functions. Even if you have an array of function pointers, you need to code them manually. A different approach is to have a full algebra module, where you enter some string representing a function and you can evaluate such function and even compute derivatives symbolically. That requires a parser, an evaluator, it is a large task. There are libraries for this. Evaluation of such a derivative will be slow unless further optimizing steps (compiling to machine code) are undertaken.
Numerical evaluation of the derivative is certainly possible. It will slow the convergence somewhat, depending on the order of the approximation of the derivative. You do a difference of two points for the numerical derivative. You can make an interpolating polynomial from values in multiple points to get a higher-order approximation (finite difference approximations), but that costs machine cycles.
Normally we can use auto difference tools as #John Alexiou mentioned. However in practise I prefer using MATLAB to analytically solve out the Jacobian and then use its build-in function fortran() to convert the result to a f90 file. Take your function as an example. Just type these into MATLAB
syms x y
Fval=sym(zeros(2,1));
Fval(1)=log(abs(x-y^2)) - sin(x*y) - sin(pi);
Fval(2)=exp(x*y) + cos(x-y) - 2;
X=[x;y];
Fjac=jacobian(Fval,X);
fortran(Fjac)
which will yield
Fjac(1,1) = -y*cos(x*y)-((-(x-y**2)/abs(-x+y**2)))/abs(-x+y**2)
Fjac(1,2) = -x*cos(x*y)+(y*((-(x-y**2)/abs(-x+y**2)))*2.0D0)/abs(-
&x+y**2)
Fjac(2,1) = -sin(x-y)+y*exp(x*y)
Fjac(2,2) = sin(x-y)+x*exp(x*y)
to you. You just get an analytical Jacobian fortran function.
Meanwhile, it is impossible to solve the inverse of a mxn matrix because of rank mismatching. You should simplify the system of equations to get a nxn Jacobin.
Additionally, when we use Newton-Raphson's method we do not solve the inverse of the Jacobin which is time-consuming and inaccurate for a large system. An easy way is to use dgesv in LAPACK for dense Jacobin. As we only need to solve the vector x from system of linear equations
Jx=-F
dgesv use LU decomposition and Gaussian elimination to solve above system of equations which is extremely faster than solving inverse matrix.
If the system of equations is large, you can use UMFPACK and its fortran interface module mUMFPACK to solve the system of equations in which J is a sparse matrix. Or use subroutine ILUD and LUSOL in a wide-spread sparse matrix library SPARSEKIT2.
In addition to these, there are tons of other methods which try to solve the Jx=-F faster and more accurate such as Generalized Minimal Residual (GMRES) and Stabilized Bi-Conjugate Gradient (BICGSTAB) which is a strand of literature.
I want to calculate z value as the coordinate in range of x:-50~50 and y:-50~50 like below code.
program test
implicit none
! --- [local entities]
real*8 :: rrr,th,U0,amp,alp,Ndiv
real*8 :: pi,alpR,NR,Rmin,Rmax,z
integer :: ir, i, j
do i=0, 50
do j=0, 50
th=datan2(i,j)
pi=datan(1.d0)*4.d0
!
Ndiv= 24.d0 !! Number of circumferential division
alp = 90.d0/180.d0*pi !! phase [rad]
U0 = 11.4d0 !! average velocity
amp = 0.5d0 !! amplitude of velocity
Rmin = 10 !! [m]
Rmax = 50 !! [m]
NR = 6.d0 !! Number of radial division
!
rrr=dsqrt(i**2+j**2)
ir=int((rrr-Rmin)/(Rmax-Rmin)*NR)
alpR=2.d0*pi/dble(Ndiv)*dble(mod(ir,2))
z=U0*(1.d0+amp*dsin(0.5d0*Ndiv*th+alp+alpR))
write(*,*) 'i, j, z'
write(*,*) i, j, z
end do
end do
stop
end program test
But I couldn't make it work like below error. I think because i, j are in datan(i,j). How should I change these code?
test.f90:10.16:
th=datan2(i,j)
1
Error: 'y' argument of 'datan2' intrinsic at (1) must be REAL
test.f90:21.16:
rrr=dsqrt(i**2+j**2)
1
Error: 'x' argument of 'dsqrt' intrinsic at (1) must be REAL
Inspired by the comments of #Rodrigo Rodrigues, #Ian Bush, and #Richard, here is a suggested rewrite of the code segment from #SW. Kim
program test
use, intrinsic :: iso_fortran_env, only : real64
implicit none
! --- [local entities]
! Determine the kind of your real variables (select one):
! for specifying a given numerical precision
integer, parameter :: wp = selected_real_kind(15, 307) !15 digits, 10**307 range
! for specifying a given number of bits
! integer, parameter :: wp = real64
real(kind=wp), parameter :: pi = atan(1._wp)*4._wp
real(kind=wp) :: rrr, th, U0, amp, alp, Ndiv
real(kind=wp) :: alpR, NR, Rmin, Rmax, z
integer :: ir, i, j
do i = 0, 50
do j = 0, 50
th = atan2(real(i, kind=wp), real(j, kind=wp))
!
Ndiv= 24._wp !! Number of circumferential division
alp = 90._wp/180._wp*pi !! phase [rad]
U0 = 11.4_wp !! average velocity
amp = 0.5_wp !! amplitude of velocity
Rmin = 10 !! [m]
Rmax = 50 !! [m]
NR = 6._wp !! Number of radial division
!
rrr = sqrt(real(i, kind=wp)**2 + real(j, kind=wp)**2)
ir = int((rrr - Rmin) / (Rmax - Rmin) * NR)
alpR = 2._wp * pi / Ndiv * mod(ir, 2)
z = U0 * (1._wp + amp * sin(0.5_wp * Ndiv * th + alp + alpR))
!
write(*,*) 'i, j, z'
write(*,*) i, j, z
end do
end do
stop
end program test
Specifically, the following changes were made with respect to the original code posted:
Minimum change to answer the question: casting integer variables i and j to real values for using them in the real valued functions datan and dsqrt.
Using generic names for intrinsic procedures, i.e sqrt instead of dsqrt, atan instead of datan, and sin instead of dsin. One benefit of this approach, is that the kind of working precision wp can be changed in one place, without requiring explicit changes elsewhere in the code.
Defining the kind of real variables and calling it wp. Extended discussion of this topic, its implications and consequences can be found on this site, for example here and here. Also #Steve Lionel has an in depth post on his blog, where his general advice is to use selected_real_kind.
Defining pi as a parameter calculating its value once, instead of calculating the same value repeatedly within the nested for loops.
I want to calculate z value as the coordinate in range of x:-50~50 and y:-50~50 like below code.
program test
implicit none
! --- [local entities]
real*8 :: rrr,th,U0,amp,alp,Ndiv
real*8 :: pi,alpR,NR,Rmin,Rmax,z
integer :: ir, i, j
do i=0, 50
do j=0, 50
th=datan2(i,j)
pi=datan(1.d0)*4.d0
!
Ndiv= 24.d0 !! Number of circumferential division
alp = 90.d0/180.d0*pi !! phase [rad]
U0 = 11.4d0 !! average velocity
amp = 0.5d0 !! amplitude of velocity
Rmin = 10 !! [m]
Rmax = 50 !! [m]
NR = 6.d0 !! Number of radial division
!
rrr=dsqrt(i**2+j**2)
ir=int((rrr-Rmin)/(Rmax-Rmin)*NR)
alpR=2.d0*pi/dble(Ndiv)*dble(mod(ir,2))
z=U0*(1.d0+amp*dsin(0.5d0*Ndiv*th+alp+alpR))
write(*,*) 'i, j, z'
write(*,*) i, j, z
end do
end do
stop
end program test
But I couldn't make it work like below error. I think because i, j are in datan(i,j). How should I change these code?
test.f90:10.16:
th=datan2(i,j)
1
Error: 'y' argument of 'datan2' intrinsic at (1) must be REAL
test.f90:21.16:
rrr=dsqrt(i**2+j**2)
1
Error: 'x' argument of 'dsqrt' intrinsic at (1) must be REAL
Inspired by the comments of #Rodrigo Rodrigues, #Ian Bush, and #Richard, here is a suggested rewrite of the code segment from #SW. Kim
program test
use, intrinsic :: iso_fortran_env, only : real64
implicit none
! --- [local entities]
! Determine the kind of your real variables (select one):
! for specifying a given numerical precision
integer, parameter :: wp = selected_real_kind(15, 307) !15 digits, 10**307 range
! for specifying a given number of bits
! integer, parameter :: wp = real64
real(kind=wp), parameter :: pi = atan(1._wp)*4._wp
real(kind=wp) :: rrr, th, U0, amp, alp, Ndiv
real(kind=wp) :: alpR, NR, Rmin, Rmax, z
integer :: ir, i, j
do i = 0, 50
do j = 0, 50
th = atan2(real(i, kind=wp), real(j, kind=wp))
!
Ndiv= 24._wp !! Number of circumferential division
alp = 90._wp/180._wp*pi !! phase [rad]
U0 = 11.4_wp !! average velocity
amp = 0.5_wp !! amplitude of velocity
Rmin = 10 !! [m]
Rmax = 50 !! [m]
NR = 6._wp !! Number of radial division
!
rrr = sqrt(real(i, kind=wp)**2 + real(j, kind=wp)**2)
ir = int((rrr - Rmin) / (Rmax - Rmin) * NR)
alpR = 2._wp * pi / Ndiv * mod(ir, 2)
z = U0 * (1._wp + amp * sin(0.5_wp * Ndiv * th + alp + alpR))
!
write(*,*) 'i, j, z'
write(*,*) i, j, z
end do
end do
stop
end program test
Specifically, the following changes were made with respect to the original code posted:
Minimum change to answer the question: casting integer variables i and j to real values for using them in the real valued functions datan and dsqrt.
Using generic names for intrinsic procedures, i.e sqrt instead of dsqrt, atan instead of datan, and sin instead of dsin. One benefit of this approach, is that the kind of working precision wp can be changed in one place, without requiring explicit changes elsewhere in the code.
Defining the kind of real variables and calling it wp. Extended discussion of this topic, its implications and consequences can be found on this site, for example here and here. Also #Steve Lionel has an in depth post on his blog, where his general advice is to use selected_real_kind.
Defining pi as a parameter calculating its value once, instead of calculating the same value repeatedly within the nested for loops.
I am trying to write a FORTRAN code to evaluate the fast Fourier transform of the Gaussian function f(r)=exp(-(r^2)) using FFTW3 library. As everyone knows, the Fourier transform of the Gaussian function is another Gaussian function.
I consider evaluating the Fourier-transform integral of the Gaussian function in the spherical coordinate.
Hence the resulting integral can be simplified to be integral of [r*exp(-(r^2))*sin(kr)]dr.
I wrote the following FORTRAN code to evaluate the discrete SINE transform DST which is the discrete Fourier transform DFT using a PURELY real input array. DST is performed by C_FFTW_RODFT00 existing in FFTW3, taking into account that the discrete values in position space are r=i*delta (i=1,2,...,1024), and the input array for DST is the function r*exp(-(r^2)) NOT the Gaussian. The sine function in the integral of [r*exp(-(r^2))*sin(kr)]dr resulting from the INTEGRATION over the SPHERICAL coordinates, and it is NOT the imaginary part of exp(ik.r) that appears when taking the analytic Fourier transform in general.
However, the result is not a Gaussian function in the momentum space.
Module FFTW3
use, intrinsic :: iso_c_binding
include 'fftw3.f03'
end module
program sine_FFT_transform
use FFTW3
implicit none
integer, parameter :: dp=selected_real_kind(8)
real(kind=dp), parameter :: pi=acos(-1.0_dp)
integer, parameter :: n=1024
real(kind=dp) :: delta, k
real(kind=dp) :: numerical_F_transform
integer :: i
type(C_PTR) :: my_plan
real(C_DOUBLE), dimension(1024) :: y
real(C_DOUBLE), dimension(1024) :: yy, yk
integer(C_FFTW_R2R_KIND) :: C_FFTW_RODFT00
my_plan= fftw_plan_r2r_1d(1024,y,yy,FFTW_FORWARD, FFTW_ESTIMATE)
delta=0.0125_dp
do i=1, n !inserting the input one-dimension position function
y(i)= 2*(delta)*(i-1)*exp(-((i-1)*delta)**2)
! I multiplied by 2 due to the definition of C_FFTW_RODFT00 in FFTW3
end do
call fftw_execute_r2r(my_plan, y,yy)
do i=2, n
k = (i-1)*pi/n/delta
yk(i) = 4*pi*delta*yy(i)/2 !I divide by 2 due to the definition of
!C_FFTW_RODFT00
numerical_F_transform=yk(i)/k
write(11,*) i,k,numerical_F_transform
end do
call fftw_destroy_plan(my_plan)
end program
Executing the previous code gives the following plot which is not for Gaussian function.
Can anyone help me understand what the problem is? I guess the problem is mainly due to FFTW3. Maybe I did not use it properly especially concerning the boundary conditions.
Looking at the related pages in the FFTW site (Real-to-Real Transforms, transform kinds, Real-odd DFT (DST)) and the header file for Fortran, it seems that FFTW expects FFTW_RODFT00 etc rather than FFTW_FORWARD for specifying the kind of
real-to-real transform. For example,
! my_plan= fftw_plan_r2r_1d( n, y, yy, FFTW_FORWARD, FFTW_ESTIMATE )
my_plan= fftw_plan_r2r_1d( n, y, yy, FFTW_RODFT00, FFTW_ESTIMATE )
performs the "type-I" discrete sine transform (DST-I) shown in the above page. This modification seems to fix the problem (i.e., makes the Fourier transform a Gaussian with positive values).
The following is a slightly modified version of OP's code to experiment the above modification:
! ... only the modified part is shown...
real(dp) :: delta, k, r, fftw, num, ana
integer :: i, j, n
type(C_PTR) :: my_plan
real(C_DOUBLE), allocatable :: y(:), yy(:)
delta = 0.0125_dp ; n = 1024 ! rmax = 12.8
! delta = 0.1_dp ; n = 128 ! rmax = 12.8
! delta = 0.2_dp ; n = 64 ! rmax = 12.8
! delta = 0.4_dp ; n = 32 ! rmax = 12.8
allocate( y( n ), yy( n ) )
! my_plan= fftw_plan_r2r_1d( n, y, yy, FFTW_FORWARD, FFTW_ESTIMATE )
my_plan= fftw_plan_r2r_1d( n, y, yy, FFTW_RODFT00, FFTW_ESTIMATE )
! Loop over r-grid
do i = 1, n
r = i * delta ! (2-a)
y( i )= r * exp( -r**2 )
end do
call fftw_execute_r2r( my_plan, y, yy )
! Loop over k-grid
do i = 1, n
! Result of FFTW
k = i * pi / ((n + 1) * delta) ! (2-b)
fftw = 4 * pi * delta * yy( i ) / k / 2 ! the last 2 due to RODFT00
! Numerical result via quadrature
num = 0
do j = 1, n
r = j * delta
num = num + r * exp( -r**2 ) * sin( k * r )
enddo
num = num * 4 * pi * delta / k
! Analytical result
ana = sqrt( pi )**3 * exp( -k**2 / 4 )
! Output
write(10,*) k, fftw
write(20,*) k, num
write(30,*) k, ana
end do
Compile (with gfortran-8.2 + FFTW3.3.8 + OSX10.11):
$ gfortran -fcheck=all -Wall sine.f90 -I/usr/local/Cellar/fftw/3.3.8/include -L/usr/local/Cellar/fftw/3.3.8/lib -lfftw3
If we use FFTW_FORWARD as in the original code, we get
which has a negative lobe (where fort.10, fort.20, and fort.30 correspond to FFTW, quadrature, and analytical results). Modifying the code to use FFTW_RODFT00 changes the result as below, so the modification seems to be working (but please see below for the grid definition).
Additional notes
I have slightly modified the grid definition for r and k in my code (Lines (2-a) and (2-b)), which is found to improve the accuracy. But I'm still not sure whether the above definition matches the definition used by FFTW, so please read the manual for details...
The fftw3.f03 header file gives the interface for fftw_plan_r2r_1d
type(C_PTR) function fftw_plan_r2r_1d(n,in,out,kind,flags) bind(C, name='fftw_plan_r2r_1d')
import
integer(C_INT), value :: n
real(C_DOUBLE), dimension(*), intent(out) :: in
real(C_DOUBLE), dimension(*), intent(out) :: out
integer(C_FFTW_R2R_KIND), value :: kind
integer(C_INT), value :: flags
end function fftw_plan_r2r_1d
(Because of no Tex support, this part is very ugly...) The integral of 4 pi r^2 * exp(-r^2) * sin(kr)/(kr) for r = 0 -> infinite is pi^(3/2) * exp(-k^2 / 4) (obtained from Wolfram Alpha or by noting that this is actually a 3-D Fourier transform of exp(-(x^2 + y^2 + z^2)) by exp(-i*(k1 x + k2 y + k3 z)) with k =(k1,k2,k3)). So, although a bit counter-intuitive, the result becomes a positive Gaussian.
I guess the r-grid can be chosen much coarser (e.g. delta up to 0.4), which gives almost the same accuracy as long as it covers the frequency domain of the transformed function (here exp(-r^2)).
Of course there are negative components of the real part to the FFT of a limited Gaussian spectrum. You are just using the real part of the transform. So your plot is absolutely correct.
You seem to be mistaking the real part with the magnitude, which of course would not be negative. For that you would need to fftw_plan_dft_r2c_1d and then calculate the absolute values of the complex coefficients. Or you might be mistaking the Fourier transform with a limited DFT.
You might want to check here to convince yourself of the correctness of you calculation above:
http://docs.mantidproject.org/nightly/algorithms/FFT-v1.html
Please do keep in mind that the plots on the above page are shifted, so that the 0 frequency is in the middle of the spectrum.
Citing yourself, the nummeric integration of [r*exp(-(r^2))*sin(kr)]dr would have negative components for all k>1 if normalised to 0 for highest frequency.
TLDR: Your plot is absolute state of the art and inline with discrete and limited functional analysis.
I am trying to write a programme to calculate an absorption band model for seismic waves. The whole calculation is based on 3 equations. If interested, see equations 3, 4, 5 on p.2 here:
http://www.eri.u-tokyo.ac.jp/people/takeuchi/publications/14EPSL-Iritani.pdf
However, I have debugged this programme several times now but I do not seem to get the expected answer. I am specifically trying to calculate Q_1 variable (seismic attenuation) in the following programme, which should be a REAL positive value on the order of 10^-3. However, I am getting negative values. I need a fresh pair of eyes to take a look at the programme and to check where I have done a mistake if any. Could someone please check? Many thanks !
PROGRAM absorp
! Calculate an absorption band model and output
! files for plotting.
! Ref. Iritani et al. (2014), EPSL, 405, 231-243.
! Variable Definition
! Corners - cf1, cf2
! Frequency range - [10^f_strt, 10^(f_end-f_strt)]
! Number of points to be sampled - n
! Angular frequency - w
! Frequency dependent Attenuation 1/Q - Q_1
! Relaxation times - tau1=1/(2*pi*cf1), tau2=1/(2*pi*cf2)
! Reference velocity - V0 (km/s)
! Attenuation (1/Q) at 1 Hz - Q1_1
! Frequency dependent peak Attenuation (1/Qm) - Qm_1
! Frequency dependent velocity - V_w
! D(omega) numerator - Dw1
! D(omega) denominator - Dw2
! D(omega) - D_w
! D(2pi) - D_2pi
IMPLICIT NONE
REAL :: cf1 = 2.0e0, cf2 = 1.0e+5
REAL, PARAMETER :: f_strt=-5, f_end=12
INTEGER :: indx
INTEGER, PARAMETER :: n=1e3
REAL, PARAMETER :: pi=4.0*atan(1.0)
REAL, DIMENSION(1:n) :: w, Q_1
REAL :: tau1, tau2, V0, freq, pow
REAL :: Q1_1=0.003, Qm_1
COMPLEX, DIMENSION(1:n) :: V_w
COMPLEX, PARAMETER :: i=(0.0,1.0)
COMPLEX :: D_2pi, D_w, Dw1, Dw2
! Reference Velocity km/s
V0 = 12.0
print *, "F1=", cf1, "F2=", cf2, "V0=",V0
! Relaxation times from corners
tau1 = 1.0/(2.0*pi*cf1)
tau2 = 1.0/(2.0*pi*cf2)
PRINT*, "tau1=",tau1, "tau2=",tau2
! Populate angular frequency array (non-linear)
DO indx = 1,n+1
pow = f_strt + f_end*REAL(indx-1)/n
freq=10**pow
w(indx) = 2*pi*freq
print *, w(indx)
END DO
! D(2pi) value
D_2pi = LOG((i*2.0*pi + 1/tau1)/(i*2.0*pi + 1/tau2))
! Calculate 1/Q from eq. 3 and 4
DO indx=1,n
!D(omega)
Dw1 = (i*w(indx) + 1.0/tau1)
Dw2 = (i*w(indx) + 1.0/tau2)
D_w = LOG(Dw1/Dw2)
!This is eq. 5 for 1/Qm
Qm_1 = 2.0*pi*Q1_1*IMAG(D_w)/ &
((Q1_1**2-4)*IMAG(D_w)**2 &
+ 4*Q1_1*IMAG(D_w)*REAL(D_w))
!This is eq. 3 for Alpha(omega)
V_w(indx) = V0*(SQRT(1.0 + 2.0/pi*Qm_1*D_w)/ &
REAL(SQRT(1.0 + 2.0/pi*Qm_1*D_2pi)))
!This is eq. 4 for 1/Q
Q_1(indx) = 2*IMAG(V_w(indx))/REAL(V_w(indx))
PRINT *, w(indx)/(2.0*pi), (V_w(indx)), Q_1(indx)
END DO
! write the results out
100 FORMAT(F12.3,3X,F7.3,3X,F8.5)
OPEN(UNIT=1, FILE='absorp.txt', STATUS='replace')
DO indx=1,n
WRITE(UNIT=1,FMT=100), w(indx)/(2.0*pi), REAL(V_w(indx)), Q_1(indx)
END DO
CLOSE(UNIT=1)
END PROGRAM
More of an extended comment with formatting than an answer ...
I haven't checked the equations you refer to, and I'm not going to, but looking at your code makes me suspect misplaced brackets as a likely cause of errors. The code, certainly as you've shown it here, isn't well formatted to reveal its logical structure. Whatever you do next invest in some indents and some longer lines to avoid breaking too frequently.
Personally I'm suspicious in particular of
!This is eq. 5 for 1/Qm
Qm_1 = 2.0*pi*Q1_1*IMAG(D_w)/ &
((Q1_1**2-4)*IMAG(D_w)**2 &
+ 4*Q1_1*IMAG(D_w)*REAL(D_w))