Related
As per title, what's the best algorithm to numerically solve a linear system in Fortran, if this system has 0s along the main diagonal?
Up to now, I had been fine using simple Gaussian elimination:
SUBROUTINE solve_lin_sys(A, c, x, n)
! =====================================================
! Uses gauss elimination and backwards substitution
! to reduce a linear system and solve it.
! Problem (0-div) can arise if there are 0s on main diag.
! =====================================================
IMPLICIT NONE
INTEGER:: i, j, k
REAL*8::fakt, summ
INTEGER, INTENT(in):: n
REAL*8, INTENT(inout):: A(n,n)
REAL*8, INTENT(inout):: c(n)
REAL*8, INTENT(out):: x(n)
DO i = 1, n-1 ! pick the var to eliminate
DO j = i+1, n ! pick the row where to eliminate
fakt = A(j,i) / A(i,i) ! elimination factor
DO k = 1, n ! eliminate
A(j,k) = A(j,k) - A(i,k)*fakt
END DO
c(j)=c(j)-c(i)*fakt ! iterate on known terms
END DO
END DO
! Actual solving:
x(n) = c(n) / A(n,n) ! last variable being solved
DO i = n-1, 1, -1
summ = 0.d0
DO j = i+1, n
summ = summ + A(i,j)*x(j)
END DO
x(i) = (c(i) - summ) / A(i,i)
END DO
END SUBROUTINE solve_lin_sys
As you can see I'm dividing by A(i,i) in the calculations. Same problem arises using Gauss-Jordan transformation or Gauss-Seidel elimination.
What's the best solution? I know i'm probably missing some really basic step but I'm a beginner programmer and apparently my linear algebra is getting rusty.
I have written a Fortran 90 code of 1-D Ising model for 100 lattice sites. I have calculated magnetization, energy, susceptibility and specific heat and plotted using gnuplot. I am getting almost expected results in E~t and m~t plots but I am unsure if c~t and sus~t plots are correct or not.
Also I have taken 100000 eqsteps for equilibrium. If i reduce the eqsteps to 100 or 200, I am getting too much fluctuation. Please help me how can I get result with smaller eqsteps.
program ising1d
implicit none
integer,allocatable,dimension(:)::lattice
real,allocatable,dimension(:)::mag
integer,dimension(100000)::seed=12345678
integer::i,row,d,p,eqsteps
integer::mcs,w
real::j,t,rval1,rval2,average_m
real::y,dE,sum_m,sum_E,average_E,E
real::sum_m2,sum_E2,average_m2,average_E2,c,sus
real,dimension(20000)::mm,EE
j=1.0
t=0.01
d=100
allocate(lattice(d))
open (unit = 9, file = "ss.txt", action = "write", status = "replace")
do while (t <= 10)
sum_E=0
sum_m=0
sum_m2=0
average_m2=0
w=1
do mcs=1,200
do row=1,d
call random_number(rval1)
if (rval1 .ge. 0.5)then
lattice(row)=1.0
else
lattice(row)=-1.0
end if
end do
! This loop is for taking measurements
! This loop is for getting equilibrium
do eqsteps=1,100000
! print*,lattice
! choosing an random site to flip
call random_number(y)
p=1+floor(y*d)
! print*,"the flipping site is :",p
! boundary condition
if(p==d) then
lattice(p+1)=lattice(1)
else if (p==1)then
lattice(p-1)=lattice(d)
else
lattice(p)=lattice(p)
end if
! energy change
dE=2*(lattice(p))*(lattice(p-1)+lattice(p+1))
! print*,"the change of energy is :",dE
! metropolis part
if (dE .le. 0) then
lattice(p)=-lattice(p)
! print*, "flipped"
else if (dE .gt. 0) then
call random_number(rval2)
if (rval2 .lt. exp(-1.0*dE/t)) then
lattice(p)=-lattice(p)
! print*, "flipped"
else
lattice(p)=lattice(p)
! print*, " not flipped"
end if
else
lattice(p)=lattice(p)
end if
end do
mm(w)=abs(sum(lattice))
sum_m = sum_m + mm(w)
sum_m2=sum_m2 + mm(w)*mm(w)
call calc_energy(d,row,E)
EE(w)=E
sum_E=sum_E+EE(w)
sum_E2=sum_E2+EE(w)*EE(w)
w=w+1
end do
average_m=sum_m/(w*d)
average_E=sum_E/(w*d)
average_m2=sum_m2/(w*w*d*d)
average_E2=sum_E2/(w*w*d*d)
c=(average_E2-average_E*average_E)/(t*t)
sus=(average_m2-average_m*average_m)/t
write(9,*) t,average_m,average_E,c,sus
print*,t,average_m,average_E,c,sus
t = t + 0.01
end do
close(9)
contains
!energy calculation
subroutine calc_energy(d,row,E)
integer,intent(in)::d,row
real, intent(out)::E
integer::k
real::E00=0
do k=2,d-1
E00=E00+lattice(k)*(lattice(k-1)+lattice(k+1))
end do
E=-0.5*(E00+lattice(1)*(lattice(2)+lattice(d))+lattice(d)*(lattice(d-1)+lattice(1)))
E00=0
end subroutine calc_energy
end program ising1d
I am expecting to get result with smaller eqstep size.
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.
I have a 3D matrix (dimension nx,nz,ny) which corresponds to a physical domain. This matrix contains a continuous field from -1 (phase 1) to +1 (phase 2); the interface between the two phases is the level 0 of this field.
Now, I want to calculate efficiently the signed distance function from the interface for every point in the domain.
I tried two possibilities (sgn is the sign of my field, with values +1,0,-1, xyz contains the grid as triplets of x,y,z at each point and dist is the signed distance function I want to calculate).
double precision, dimension(nx,nz,ny) :: dist,sgn,eudist
integer :: i,j,k
double precision :: seed,posit,tmp(nx)
do j=1,ny
do k=1,nz
do i=1,nx
seed=sgn(i,k,j)
! look for interface
eudist=(xyz(:,:,:,1)-x(i))**2+(xyz(:,:,:,2)-z(k))**2+(xyz(:,:,:,3)-y(j))**2
! find min within mask
posit=minval(eudist,seed*sgn.le.0)
! tmp fits in cache, small speed-up
tmp(i)=-seed*dsqrt(posit)
enddo
dist(:,k,j)=tmp
enddo
enddo
I also tried a second version, which is quite similar to the above one but it calculates the Euclidean distance only in a subset of the whole matrix. With this second version there is some speed up, but it is still too slow. I would like to know whether there is a more efficient way to calculate the distance function.
Second version:
double precision, dimension(nx,nz,ny) :: dist,sgn
double precision, allocatable, dimension(:,:,:) :: eudist
integer :: i,j,k , ii,jj,kk
integer :: il,iu,jl,ju,kl,ku
double precision :: seed, deltax,deltay,deltaz,tmp(nx)
deltax=max(int(nx/4),1)
deltay=max(int(ny/4),1)
deltaz=max(int(nz/2),1)
allocate(eudist(2*deltax+1,2*deltaz+1,2*deltay+1))
do j=1,ny
do k=1,nz
do i=1,nx
! look for closest point in box 2*deltax+1,2*deltaz+1,2*deltay+1
il=max(1,i-deltax)
iu=min(nx,i+deltax)
jl=max(1,j-deltay)
ju=min(ny,j+deltay)
kl=max(1,k-deltaz)
ku=min(nz,k+deltaz)
eudist(:,1:ku-kl+1,:)=(xyz(il:iu,kl:ku,jl:ju,1)-x(i))**2 &
& +(xyz(il:iu,kl:ku,jl:ju,2)-z(k))**2 &
& +(xyz(il:iu,kl:ku,jl:ju,3)-y(j))**2
seed=sgn(i,k,j)
tmp(i)=minval(eudist(:,1:ku-kl+1,:),seed*sgn(il:iu,kl:ku,jl:ju).le.0)
tmp(i)=-seed*dsqrt(tmp(i))
enddo
dist(:,k,j)=tmp
enddo
enddo
eudist: Euclidean distance between the point i,k,j and any other point in a box 2*deltax+1,2*deltaz+1,2*deltay+1 centered in i,k,j. This reduces computational cost, as the distance is calculated only in a subset of the whole grid (here I am assuming that the subset is large enough to contain an interfacial point).
After Vladimir suggestion (x,y,z are the axes determining grid position, xyz(i,k,j)=(x(i),z(k),y(j)) ):
double precision, dimension(nx,nz,ny) :: dist,sgn
double precision :: x(nx), y(ny), z(nz)
double precision, allocatable, dimension(:,:,:) :: eudist
double precision, allocatable, dimension(:) :: xd,yd,zd
integer :: i,j,k , ii,jj,kk
integer :: il,iu,jl,ju,kl,ku
double precision :: seed, deltax,deltay,deltaz,tmp(nx)
deltax=max(int(nx/4),1)
deltay=max(int(ny/4),1)
deltaz=max(int(nz/2),1)
allocate(eudist(2*deltax+1,2*deltaz+1,2*deltay+1))
allocate(xd(2*deltax+1))
allocate(yd(2*deltay+1))
allocate(zd(2*deltaz+1))
do j=1,ny
do k=1,nz
do i=1,nx
! look for closest point in box 2*deltax+1,2*deltaz+1,2*deltay+1
il=max(1,i-deltax)
iu=min(nx,i+deltax)
jl=max(1,j-deltay)
ju=min(ny,j+deltay)
kl=max(1,k-deltaz)
ku=min(nz,k+deltaz)
do ii=1,iu-il+1
xd(ii)=(xyz(il+ii-1)-x(i))**2
end do
do jj=1,ju-jl+1
yd(jj)=(y(jj+jl-1)-y(j))**2
end do
do kk=1,ku-kl+1
zd(kk)=(z(kk+kl-1)-z(k))**2
end do
do jj=1,ju-jl+1
do kk=1,ku-kl+1
do ii=1,iu-il+1
eudist(ii,kk,jj)=xd(ii)+yd(jj)+zd(kk)
enddo
enddo
enddo
seed=sgn(i,k,j)
tmp(i)=minval(eudist(:,1:ku-kl+1,:),seed*sgn(il:iu,kl:ku,jl:ju).le.0)
tmp(i)=-seed*dsqrt(tmp(i))
enddo
dist(:,k,j)=tmp
enddo
enddo
EDIT: more information on the problem at hand.
The grid is an orthogonal grid mapped to a matrix. The number of points of this grid is of the order of 1000 in each direction (in total about 1 billion points).
My goal is switching from a sign function (+1,0,-1) to a signed distance function in the entire grid in an efficient way.
I would still do what I suggested, no matter if you do that on a subset or across the whole plane. Take advantage of the orthogonal grid, it is a great thing to have
do j=1,ny
do k=1,nz
do i=1,nx
! look for closest point in box 2*deltax+1,2*deltaz+1,2*deltay+1
il=max(1,i-deltax)
iu=min(nx,i+deltax)
jl=max(1,j-deltay)
ju=min(ny,j+deltay)
kl=max(1,k-deltaz)
ku=min(nz,k+deltaz)
do ii = il,iu
xd(i) = (xyz(ii,kl:ku,jl:ju,1)-x(i))**2
end do
do jj = jl,ju
yd(i) = (xyz(il:iu,kl:ku,jj,2)-y(j))**2
end do
do kk = kl,ku
zd(k) = (xyz(il:iu,kk,jl:ju,3)-z(k))**2
end do
do jj = jl,ju
do kk = kl,ku
do ii = il,iu
eudist(il:iu,kl:ku,jl:ju) = xd(ii) + yd(jj) + zd(kk)
end do
end do
end do
....
enddo
dist(:,k,j)=tmp
enddo
enddo
Consider separating the whole thing that is inside the outer triple loop into a subroutine or a function. It would not be faster, but it would be much more readable. Especially for us here, It would be enough for us here to only deal with that function, the outer loop is just a confusing extra layer.
I want to do a fixed calculation step for multiple .dat files.
Here is my code for what I want to do with one .dat file i.e. the calculation:
dimension t(128716),x(128716)
open (unit=88,file='ALFA-gua-100m-2.dat',status='unknown')
do i=1,128716
read(88,*)t(i),x(i)
enddo
sum=0
do j=1,128716
sum=sum+x(j)
enddo
write(*,*)sum/128716
close(88)
stop
end
How do I go about this? Please suggest!
Here is my code for multiple file :
dimension t(128716),x(128716)
open (unit=11,file='ALFA-gua-100m-2.dat',status='unknown')
open (unit=12,file='ALFA-gua-100m-5.dat',status='unknown')
do i=1,2
ii = i + 10
do j=1,128716
read(ii,*)t(j),x(j)
enddo
sum=0
do k=1,128716
sum=sum+x(k)
enddo
enddo
do l=1,2
ll = l + 10
write(ll,*)sum/128716.0
close(ll)
enddo
stop
end
But its not working.
An addendum to #VladimirF's answer.
To sum all the elements in an array called x we can simply write
sumx = sum(x)
there is no need for the programmer to write a loop at all. If using an array of sums, then something like
sums(1) = sum(x)
would be appropriate.
Then to calculate the mean of an array I'd write
meanx = sum(x)/size(x)
While I'm writing: it's not a good idea to call a variable sum. There's an existing intrinsic function of that name and it will only confuse readers (though not the compiler) to have a variable of that name too.
You cannot use the same sum for two iterations of the i loop when you have two separate loops. It will get overwritten when processing the second file.
You can join the loops into one.
do i=1,2
ii = i + 10
do j=1,128716
read(ii,*)t(j),x(j)
enddo
sum=0
do k=1,128716
sum=sum+x(k)
enddo
write(ii,*)sum/128716.0
close(ii)
enddo
You can use an array for the sums sums(i).
do i=1,2
ii = i + 10
do j=1,128716
read(ii,*)t(j),x(j)
enddo
sum=0
do k=1,128716
sums(i)=sums(i)+x(k)
enddo
enddo
do l=1,2
ll = l + 10
write(ll,*)sums(l)/128716.0
close(ll)
enddo