I am struggling with this simple derivative of a sine with FFTW. At a first look it seems ok but then there is a quite big error (5e-6) when compared with the exact solution...
I do see that after taking the c2r the complex input is all messed up, but it seems to me that same complex input is the cause of my problem... What am I doing wrong? I didn't use any pointer and tried to keep everything as simple as possible; still I can't figure out what's wrong.
Any help is appreciated! Thanks!!!
program main
! C binding
use, intrinsic :: iso_c_binding
implicit none
double precision, parameter :: pi = 4*ATAN(1.0)
complex, parameter :: ii =(0.0,1.0)
integer(C_INT), parameter :: Nx = 32
integer(C_INT), parameter :: Ny = Nx
double precision, parameter :: Lx = 2*pi, Ly = 2*pi
! Derived paramenter
double precision, parameter :: dx = Lx/Nx, dy = Ly/Ny
real(C_DOUBLE), dimension(Nx,Ny) :: x,y, u0,in,dudx,dudxE, errdU
real(C_DOUBLE), dimension(Nx/2+1,Ny) :: kx, ky
! Fourier space variables
complex(C_DOUBLE_COMPLEX), dimension(Nx/2+1,Ny) :: u_hat_x, out
! indices
integer :: i, j
!---FFTW plans
type(C_PTR) :: pf, pb
! FFTW include
include 'fftw3.f03'
write(*,'(A)') 'Starting...'
! Grid
forall(i=1:Nx,j=1:Ny)
x(i,j) = (i-1)*dx
y(i,j) = (j-1)*dy
end forall
! Compute the wavenumbers
forall(i=1:Nx/2,j=1:Ny) kx(i,j)=2*pi*(i-1)/Lx
kx(Nx/2+1,:) = 0.0
forall(i=1:Nx/2+1,j=1:Ny/2) ky(i,j)=2*pi*(j-1)/Ly
forall(i=1:Nx/2+1,j=Ny/2+1:Ny) ky(i,j)=2*pi*(j-Ny-1)/Ly
! Initial Condition
u0 = sin(2*x)
dudxE = 2*cos(2*x)
! Go to Fourier Space
in = u0
pf = fftw_plan_dft_r2c_2d(Ny, Nx, in,out ,FFTW_ESTIMATE)
call fftw_execute_dft_r2c(pf,in,out)
u_hat_x = out
! Derivative
out = ii*kx*out
! Back to physical space
pb = fftw_plan_dft_c2r_2d(Ny, Nx, out,in,FFTW_ESTIMATE)
call fftw_execute_dft_c2r(pb,out,in)
! rescale
dudx = in/Nx/Ny
! check the derivative
errdU = dudx - dudxE
! Write file
write(*,*) 'Writing to files...'
OPEN(UNIT=1, FILE="out_for.dat", ACTION="write", STATUS="replace", &
FORM="unformatted")
WRITE(1) kx,u0,dudx,errdU,abs(u_hat_x)
CLOSE(UNIT=1)
call fftw_destroy_plan(pf)
call fftw_destroy_plan(pb)
write(*,'(A)') 'Done!'
end program main
steabert was right! the problem was simply with the pi definition which was only single precision! Thank you so much!
Related
I am currently implementing integrals in Fortran as subroutines. The subroutines on their own return the correct values. If i now call the e.g. same subroutine twice after each other, with the same input values, their returned value differs significantly?
The main program only calls the function like this:
program main
use types
use constants
use integrals
use basis
real(dp), dimension(2,3) :: molecule_coords
real(dp), dimension(2) :: z
type(primitive_gaussian), allocatable :: molecule(:,:)
molecule_coords(1,:) = (/0.,0.,0./)
molecule_coords(2,:) = (/0.,0.,1.6/)
molecule = def_molecule(molecule_coords)
z = (/1.0, 1.0/)
call overlap(molecule) ! Correct Value returned
call overlap(molecule) ! Wrong Value returned
end program main
My function for the overlap looks like this:
module integrals
use types
use constants
use basis
use stdlib_specialfunctions_gamma!, only: lig => lower_incomplete_gamma
contains
subroutine overlap(molecule)
implicit none
type(primitive_gaussian), intent(in) :: molecule(:,:)
integer :: nbasis, i, j, k, l
real(dp) :: norm, p, q, coeff, Kab
real(dp), dimension(3) :: Q_xyz
real(dp), dimension(INT(size(molecule,1)),INT(size(molecule,1))) :: S
nbasis = size(molecule,1)
do i = 1, nbasis
do j = 1, nbasis
! Iterate over l and m primitives in basis
do k = 1, size(molecule(i,:))
do l = 1, size(molecule(j,:))
norm = molecule(i, k)%norm() * molecule(j, l)%norm()
! Eq. 63
Q_xyz = (molecule(i, k)%coords - molecule(j, l)%coords)
! Eq. 64, 65
p = (molecule(i, k)%alpha + molecule(j, l)%alpha)
q = (molecule(i, k)%alpha * molecule(j, l)%alpha) / p
! Eq. 66
Kab = exp(-q * dot_product(Q_xyz,Q_xyz))
coeff = molecule(i, k)%coeff * molecule(j, l)%coeff
S(i,j) = S(i,j) + norm * coeff * Kab * (pi / p) ** (1.5)
end do
end do
end do
end do
print *, S
end subroutine overlap
end module integrals
I am a bit lost, why this would be the case, but I am also rather new to Fortran.
Any help is appreciated! Thanks!
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.
this question follows from my last question, but now with the code.
I have problems with the "Fastest Fourier Transform in the West" (link) implemented in Fortran, in particular calculating the inverse of the fft. When I test with small matrices the result is perfect, but from 8x8 on the result is wrong.
Here is my code here. I written it with comments inside. The example matrices are in the files ex1.dat,... ex5.dat, so it is easy to test (I use the intel compiler, I'm not sure that runs with gfortran). Examples ex2 and ex3 works perfect (5x5 and 7x7), but the other examples give wrong results, so I can't understand the error or where looking for.
Inside the code: to verify that all is right I calculate
PRINT*, MINVAL( AA - AA_new ), MAXVAL( AA-AA_new )
where AA is the original matrix, and AA_new is the matrix AA after calculate the fft and then the inverse of the fft. We expect that AA==AA_new, so we expect that MINVAL( AA - AA_new ), MAXVAL( AA-AA_new ) be zero. But for bigger matrices these numbers are big, so AA and AA_new are very different.
Also I'm comparing the result with the command fft2 of matlab, because uses the same library according its documentation.
About the code:
the main file is fft_test.f90,
and all corresponding to the calculus of the fft using fftw3 is in fft_modules.f90.
-The definition of _dp (the precision) is in decimal.f90.
You can download the code from the last link, but also I write below:
PROGRAM fftw_test
!
USE decimal
USE fftw_module
!
IMPLICIT NONE
!
REAL(KIND=dp), ALLOCATABLE :: AA(:,:), AA_new(:,:)
COMPLEX(KIND=dp), ALLOCATABLE :: ATF(:,:)
INTEGER :: NN, MM, ii, jj
!
OPEN(unit=10,file='ex2.dat',status='old',action='read')
READ(10,*) NN,MM ! <- NNxMM is the size of the matrix inside the file vel1.dat
!
ALLOCATE( AA(NN,MM), AA_new(NN,MM), ATF(NN,MM) )
AA = 0.0_dp; AA_new = 0.0_dp; ATF = 0.0_dp
!
DO ii=1,NN
READ(10,*) ( AA(ii,jj), jj=1,NN ) ! AA is the original matrix (real)
END DO
CLOSE(10)
!
PRINT*,'MIN and MAX value of AA' !<- just to verify that is not null
PRINT*, MINVAL( AA ), MAXVAL( AA )
!
CALL fft(NN,MM,AA,ATF) ! ATF (complex) is the fft of AA (real)
!
CALL ifft(NN,MM,ATF,AA_new) ! AA_new is the inverse fft AA, so must be == AA
!
PRINT*,'MIN and MAX value of AA_new' !<- just to verify that is not null
PRINT*, MINVAL( AA_new ), MAXVAL( AA_new )
!
PRINT*,'Max and min val of (AA-AA_new)'!<- just to compare some way the result
PRINT*, MINVAL( AA - AA_new ), MAXVAL( AA-AA_new )
PRINT*,' ------------------------------------------------------------------- '
!
DEALLOCATE( AA, ATF )
!
END PROGRAM fftw_test
MODULE fftw_module
!
! Contains the forward and inverse discrete fourier transform of a matrix
! using the library fftw3
!
USE decimal
!
CONTAINS
!
SUBROUTINE fft(NX,NY,AA,ATF)
!
! Calculate the forward Discrete Fourier transform ATF of the matriz AA
! Both matrices have the same size, but AA (the input) is real
! and ATF (the output) is complex
!
USE, INTRINSIC :: iso_c_binding
IMPLICIT none
INCLUDE 'fftw3.f03'
! include 'aslfftw3.f03'
!
INTEGER(C_INT), INTENT(in) :: Nx, Ny
COMPLEX(C_DOUBLE_COMPLEX), ALLOCATABLE :: zin(:), zout(:)
TYPE(C_PTR) :: planf
!
INTEGER :: ii, yy, ix, iy
REAL(KIND=dp) :: AA(:,:)
COMPLEX(KIND=dp) :: ATF(:,:)
!
ALLOCATE( zin(NX * NY), zout(NX * NY) )
!
! Plan Creation (out-of-place forward and backward FFT)
planf = fftw_plan_dft_2d(NY, NX, zin, zout, FFTW_FORWARD, FFTW_ESTIMATE)
IF ( .NOT. C_ASSOCIATED(planf) ) THEN
PRINT*, "plan creation error!!"
STOP
END IF
!
zin = CMPLX( RESHAPE( AA, (/ NX*NY /) ) , KIND=dp )
!
! FFT Execution (forward)
CALL FFTW_EXECUTE_DFT(planf, zin, zout)
!
DO iy = 1, Ny
DO ix = 1, Nx
ii = ix + nx*(iy-1)
ATF(ix,iy) = zout(ii)
END DO
END DO
!
! Plan Destruction
CALL FFTW_DESTROY_PLAN(planf)
CALL FFTW_CLEANUP
!
DEALLOCATE( zin, zout )
!
END SUBROUTINE fft
!
!
SUBROUTINE ifft(NX,NY,ATF,AA)
!
! Calculate the inverse Discrete Fourier transform ATF of the matriz AA
! Both matrices have the same size, but AA ATF (the input) is complex
! and AA (the output) is real
!
USE, INTRINSIC :: iso_c_binding
IMPLICIT none
INCLUDE 'fftw3.f03'
! include 'aslfftw3.f03'
!
INTEGER(C_INT), INTENT(in) :: Nx, Ny
COMPLEX(C_DOUBLE_COMPLEX), ALLOCATABLE :: zin(:), zout(:)
TYPE(C_PTR) :: planb
!
INTEGER :: ii, yy, ix, iy
REAL(KIND=dp) :: AA(:,:)
COMPLEX(KIND=dp) :: ATF(:,:)
!
ALLOCATE( zin(NX * NY), zout(NX * NY) )
!
! Plan Creation (out-of-place forward and backward FFT)
planb = fftw_plan_dft_2d(NY, NX, zin, zout, FFTW_BACKWARD, FFTW_ESTIMATE)
IF ( .NOT. C_ASSOCIATED(planb) ) THEN
PRINT*, "plan creation error!!"
STOP
END IF
!
zin = RESHAPE( ATF, (/ NX*NY /) )
!
! FFT Execution (backward)
! CALL FFTW_EXECUTE_DFT(planb, zout, zin)
CALL FFTW_EXECUTE_DFT(planb, zin, zout)
!
DO iy = 1, Ny
DO ix = 1, Nx
ii = ix + nx*(iy-1)
AA(ix,iy) = dble( zout(ii) )
END DO
END DO
!
! Plan Destruction
CALL FFTW_DESTROY_PLAN(planb)
CALL FFTW_CLEANUP
!
DEALLOCATE( zin, zout )
!
END SUBROUTINE ifft
!
END MODULE fftw_module
MODULE decimal
!
! Precision in the whole program
!
! dp : double precision
! sp : simple precision
!
IMPLICIT NONE
!
INTEGER, PARAMETER :: dp = KIND(1.D0)
INTEGER, PARAMETER :: sp = KIND(1.0)
!
END MODULE decimal
A matrix example (that works because is small), corresponding on the ex2.dat input file:
5 5
1 2 3 4 5.3
6 7 8 9 10
11 12 3 5 3
0.1 -0.32 0.4 70 12
0 1 0 -1 0 -70
When you perform a forward and then a back discrete Fourier Transform on some data the normalisation of the result is conventional, usually you either get the data back as it was (to floating point accuracy), or if you are using an unnormalised transform the data will be scaled by the number of points in the data set, or you provide the normalisation as an argument. To find out which you will have read the documentation of whatever software you are using to do the transforms; fftw uses unnormalised transforms . Thus in your code you will need to preform the appropriate scaling. And if you run your code on your datasets you find the scaling is as described - on a 10x10 dataset the final data is 100 times the original data.
I cannot reproduce your claim that the code as given works for the smaller data sets. I get the expected scaling.
this is the program. and I got an error why?
''''code'''''
I don't know why the whole doesn't appear, I tried to determine the area and volume for a random number.
----------------why-------------
'''Fortran
'program exercise2'
!
integer :: N,i
type :: Values
double precision :: radius,area,volume
end type
!
!
type(Values),allocatable, dimension(:) :: s
integer :: bi
!
!Read the data to create the random number
write(6,*) 'write your number '
read(5,*) N
allocate(s(N))
bi = 3.14
!create the random number
call random_seed()
do i=1,N
call random_number(s(i)%radius)
s(i)%area=areacircle(s(i)%radius)
s(i)%volume=volumesphere(s(i)%radius)
end do
!
open(15,file='radius.out',status='new')
write(15,*) s(i)%radius
open(16,file='output2.out',status='new')
r = real(s(i)%radius)
!Two function
contains
double precision function areacircle (s)
implicit none
double precision :: s
do i=1 , N
areacircle=bi*r**2
end do
return
end function areacircle
!
!
double precision function volumesphere (s)
implicit none
double precision :: s
do i=1,N
volumesphere=4/3*bi*r**3
end do
return
write(16,*) r , areacircle , volumesphere
end function volumesphere
'end program exercise2'
'''''''
so anyone know why?
This likely does what you want. As the computation of area and volume involve a single input that does not change, I've changed your functions to be elemental. This allows an array argument where the function is executed for each element of the array. I also changed double precision to use Fortran kind type parameter mechanism, because typing is real(dp) is much shorter.
Finally, never write a Fortran program without the implicit none statement.
program exercise2
implicit none ! Never write a program without this statement
integer, parameter :: dp = kind(1.d0) ! kind type parameter
integer n, i
type values
real(dp) radius, area, volume
end type
type(values), allocatable :: s(:)
real(dp) bi ! integer :: bi?
! Read the data to create the random number
write(6,*) 'write your number '
read(5,*) n
! Validate n is validate.
if (n < 1) stop 'Invalid number'
allocate(s(n))
bi = 4 * atan(1.d0) ! bi = 3.14? correctly determine pi
call random_seed() ! Use default seeding
call random_number(s%radius) ! Fill radii with random numbers
s%area = areacircle(s%radius) ! Compute area
s%volume = volumesphere(s%radius) ! Compute volume
write(*,'(A)') ' Radii Area Volume'
do i = 1, n
write(*, '(3F9.5)') s(i)
end do
contains
elemental function areacircle(s) result(area)
real(dp) area
real(dp), intent(in) :: s
area = bi * s**2
end function areacircle
elemental function volumesphere(s) result(volume)
real(dp) volume
real(dp), intent(in) :: s
volume = (4 * bi / 3) * s**3
end function volumesphere
end program exercise2
I want to integrate a 3d array over space in r, theta and phi (spherical polar). For 1d I use Simpson's 1/3rd rule but I am confused about that for 3d. Also, would you like to suggest any other method for integration or subroutine? I am using Fortran 95.
I have written the Fortran code for integration in 3d, I thought I should share with you.
The code for calculating integration of a function is 3 dimension is:
!This program uses Simpson's 1/3 method to calulate volume
integral in r,theta & phi.
program SimpsonInteg3d
implicit none
integer::i,j,k
integer, parameter :: N=10,M=360,L=180
integer, parameter:: rmin=0,rmax=N,phimin=0,phimax=M,&
thetamin=0,thetamax=L
double precision,&
dimension(rmin:rmax,thetamin:thetamax,phimin:phimax)::U
real*8, parameter :: pi = 4*atan(1.0),dr=1./N,&
dtheta=pi/(L),dphi=2*pi/M
real*8 :: r(rmin:rmax)=(/(i*dr,i=rmin,rmax)/),&
theta(thetamin:thetamax)=(/(j*dtheta,j=thetamin,thetamax)/),&
p(phimin:phimax)=(/(k*dphi,k=phimin,phimax)/)
real*8::intg
do i=rmin,rmax
do j=thetamin, thetamax
do k=phimin,phimax
!The function which has to be integrated.
U(i,j,k)=r(i)* (sin((p(k)))**2) *sin(theta(j))
enddo
enddo
enddo
call Integration(Intg,U,r,theta,p)
print*,"Integration of function U using simpson's 1/3=", Intg
end program
!===============================================================!
!Subroutine for calculating integral of a function in 3d.
subroutine Integration(Intg,U,r,theta,p)
implicit none
integer::i,j,k
integer, parameter :: N=10,M=360,L=180
integer, parameter ::rmin=0,rmax=N,&
phimin=0,phimax=M,thetamin=0,thetamax=L
double precision,&
dimension(rmin:rmax,thetamin:thetamax,phimin:phimax):: U
real*8::
r(rmin:rmax),theta(thetamin:thetamax),p(phimin:phimax),Intg,Ia
double precision,dimension(rmin:rmax)::Itheta
real*8, parameter :: pi = 4*atan(1.0),dr=1./N,&
dtheta=pi/(L),dphi=2*pi/M
Intg=0
Ia=0
do i=rmin+1,rmax-1
call Integtheta(Itheta,i,U,r,theta,p)
if(mod(i,2).eq.0) then
Ia = Ia + 2*Itheta(i)*r(i)**2
else
Ia = Ia + 4*Itheta(i)*r(i)**2
endif
end do
call Integtheta(Itheta,rmin,U,r,theta,p)
call Integtheta(Itheta,rmax,U,r,theta,p)
Intg=(dr/3)*(Itheta(rmin)+Itheta(rmax)+ Ia)
end subroutine Integration
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!Subroutine for calculating integral of U along theta and phi
subroutine Integtheta(Itheta,i,U,r,theta,p)
implicit none
integer::i,j,k
integer, parameter :: N=10,M=360,L=180
integer, parameter ::rmin=0,rmax=N,&
phimin=0,phimax=M,thetamin=0,thetamax=L
double precision,&
dimension(rmin:rmax,thetamin:thetamax,phimin:phimax)::U
real*8:: r(rmin:rmax),theta(thetamin:thetamax),p(phimin:phimax)
double precision,dimension(rmin:rmax)::Itheta,Itha
double precision,dimension(rmin:rmax,thetamin:thetamax)::Ip
real*8, parameter :: pi = 4*atan(1.0),dr=1./N,&
dtheta=pi/(L),dphi=2*pi/M
Itheta(i)=0
Itha(i)=0
do j=thetamin+1,thetamax-1
call Integphi(Ip,i,j,U,r,theta,p)
if(mod(j,2).eq.0) then
Itha(i) = Itha(i) + 2*Ip(i,j)*sin(theta(j))
else
Itha(i) = Itha(i) + 4*Ip(i,j)*sin(theta(j))
endif
end do
call Integphi(Ip,i,thetamin,U,r,theta,p)
call Integphi(Ip,i,thetamax,U,r,theta,p)
Itheta(i)=(dtheta/3)*(Ip(i,thetamin)+Ip(i,thetamax)+ Itha(i))
end subroutine Integtheta
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!Subroutine for calculating integral of U along phi
subroutine Integphi(Ip,i,j,U,r,theta,p)
implicit none
integer::i,j,k
integer, parameter :: N=10,M=360,L=180
integer, parameter ::rmin=0,rmax=N,&
phimin=0,phimax=M,thetamin=0,thetamax=L
double precision,&
dimension(rmin:rmax,thetamin:thetamax,phimin:phimax)::U
real*8:: r(rmin:rmax),theta(thetamin:thetamax),p(phimin:phimax)
double precision,dimension(rmin:rmax,thetamin:thetamax)::Ip,Ipa
real*8, parameter :: pi = 4*atan(1.0),dr=1./N,&
dtheta=pi/(L),dphi=2*pi/M
Ipa(i,j)=0
do k=phimin+1,phimax-1
if(mod(k,2).eq.0) then
Ipa(i,j) = Ipa(i,j) + 2*U(i,j,k)
else
Ipa(i,j)= Ipa(i,j) + 4*U(i,j,k)
endif
end do
Ip(i,j)=(dphi/3)*(U(i,j,phimin)+U(i,j,phimax)+ Ipa(i,j))
end subroutine Integphi
It calculates the integration of the function U along phi first and then uses the function Ip to calculate integral along theta. Then finally the function Itheta is used to calculate integration along r.