I want to find the minimal norm, least square solution of an equation
Ax = b
using LAPACK's driver sgelsx in Fortran. In its documentation, it says that the least square solution is stored as b after calling this subroutine but but the dimensions of b and x are generally different, so how can it be identified as the solution?
I have tried calculating a provided example so I can compare the result of my code with the solution, and it's clearly different.
My program is
program test_svd
implicit none
integer:: m,n,nrhs,LDA,LDB,RANK,INFO,i,nwork
integer, allocatable, dimension(:)::JPVT
real, allocatable, dimension(:):: work
real, allocatable, dimension(:,:):: a
real, allocatable, dimension(:,:):: b
real:: RCOND
m = 5
n = 2
nrhs = 1
LDA = 10
LDB = 10
RCOND = 500.0
nwork = maxval( [minval([m,n])+3*n, 2*minval([m,n])+nrhs ])
allocate(b(LDB,nrhs))
allocate(a(LDA,n))
allocate(JPVT(n))
allocate(work(nwork ))
JPVT = (/ (1.0 , i = 1,n) /)
a(1,1) = 1.0
a(2,1) = 1.0
a(3,1) = 1.0
a(4,1) = 1.0
a(5,1) = 1.0
a(1,2) = -2.0
a(2,2) = -1.0
a(3,2) = 0.0
a(4,2) = 2.0
a(5,2) = 3.0
b(1,1) = 4.0
b(2,1) = 2.0
b(3,1) = 1.0
b(4,1) = 1.0
b(5,1) = 1.0
!print *, a, size(a)
!print *, b, size(b)
call sgelsx(m,n,nrhs,a,LDA,b,LDB,JPVT,RCOND,RANK,work,INFO)
print *, b
end
What I get as b (the solution) is [1.55172420 0.620689809 -1.36653137 -0.703225672 -0.371572882], which is supposed to be [2, -0.5].
Problem was solved. It turns out that rcond is a parameter used to set a threshold below which the singular values of A is set to zero, so rcond should be like 0.001 or 0.1 depending on the condition number of A. Unfortunately, I found this explanation in another routine's documentation. I wonder why the author didn't use the same, which is more descriptive, explanation for rcond in sgelsx.
Related
I'd like to use FFTW to compute the Fourier Harmonics for a 2D dataset. And I think I'm getting the hang of it but I need to 'decipher' the complex output in terms of harmonics. First here's my toy code:
PROGRAM FFTW_TEST
USE, intrinsic :: iso_c_binding
IMPLICIT NONE
INTEGER :: i, j, n, m, l, k
REAL :: pi2, norm, norm2
REAL(C_DOUBLE), POINTER, DIMENSION(:) :: theta, func
COMPLEX(C_DOUBLE_COMPLEX), POINTER, DIMENSION(:) :: fmn_1d
REAL(C_DOUBLE), POINTER, DIMENSION(:,:) :: func_2d, r_2d, i_2d
COMPLEX(C_DOUBLE_COMPLEX), POINTER, DIMENSION(:,:) :: fmn_2d
INCLUDE 'fftw3.f03'
TYPE(C_PTR) :: plan
TYPE(C_PTR) :: real_1d, complex_1d
TYPE(C_PTR) :: real_2d, complex_2d
pi2 = 8.0 * ATAN(1.0)
!------ 1D Example
n = 64
real_1d = FFTW_ALLOC_REAL(INT(n,C_SIZE_T))
complex_1d = FFTW_ALLOC_COMPLEX(INT(n,C_SIZE_T))
CALL C_F_POINTER(real_1d, func, [n])
CALL C_F_POINTER(complex_1d, fmn_1d, [n])
ALLOCATE(theta(n))
FORALL(i=1:n) theta(i) = DBLE(i-1)/DBLE(n)
FORALL(i=1:n) func(i) = 1.0+2.0*cos(2*pi2*theta(i))-3.0*cos(3*pi2*theta(i)) ! Even Values
! FORALL(i=1:n) func(i) = 0.0+2.0*sin(4*pi2*theta(i))-3.0*sin(5*pi2*theta(i)) ! Odd Values
WRITE(401,*) func(1:n)
CALL FLUSH(401)
norm = n/2
norm2 = n
plan = FFTW_PLAN_DFT_R2C_1D(n, func, fmn_1d, FFTW_ESTIMATE)
CALL FFTW_EXECUTE_DFT_R2C(plan, func, fmn_1d)
CALL FFTW_DESTROY_PLAN(plan)
func = REAL(fmn_1d)/norm
func(1) = 2*func(1)
WRITE(402,*) func; CALL FLUSH(402)
func = -AIMAG(fmn_1d)/norm
func(1) = 2*func(1) ! note should be zero
WRITE(403,*) func; CALL FLUSH(403)
plan = FFTW_PLAN_DFT_C2R_1D(n, fmn_1d, func, FFTW_ESTIMATE)
CALL FFTW_EXECUTE_DFT_C2R(plan, fmn_1d, func)
CALL FFTW_DESTROY_PLAN(plan)
WRITE(404,*) func/norm2; CALL FLUSH(404)
CALL FFTW_FREE(real_1d)
CALL FFTW_FREE(complex_1d)
IF (ASSOCIATED(theta)) DEALLOCATE(theta)
!------- 2D Example
m=16
n=8
real_2d = FFTW_ALLOC_REAL(INT(m*n,C_SIZE_T))
complex_2d = FFTW_ALLOC_COMPLEX(INT(m*n,C_SIZE_T))
CALL C_F_POINTER(real_2d, func_2d, [m,n])
CALL C_F_POINTER(complex_2d, fmn_2d, [m,n])
PRINT *,LBOUND(func_2d,DIM=1)
ALLOCATE(fmn_1d(m),r_2d(m,n),i_2d(m,n))
func_2d = 0.5
DO i = 1, m
DO j = 1, n
DO l = 0, 8
DO k = -4,4
func_2d(i,j) = func_2d(i,j) + (l*100+k) * cos(l*pi2*(i-1)/m + k*pi2*(j-1)/n)
END DO
END DO
END DO
WRITE(501,*) func_2d(i,1:n); CALL FLUSH(501)
END DO
! Note in the m direction we read m=0,1,2,3,4...
! in the n direction we read n=0..nx/2,-nx/2+1...-1
norm = m*n/2
norm2 = norm*2
plan = FFTW_PLAN_DFT_R2C_2D(n, m, func_2d, fmn_2d, FFTW_ESTIMATE)
CALL FFTW_EXECUTE_DFT_R2C(plan, func_2d, fmn_2d)
CALL FFTW_DESTROY_PLAN(plan)
r_2d = REAL(fmn_2d)/norm
r_2d(1,1) = r_2d(1,1)/2
DO i = 1, m
WRITE(502,*) r_2d(i,1:n); CALL FLUSH(502)
END DO
i_2d = -AIMAG(fmn_2d)/norm
i_2d(1,1) = i_2d(1,1)/2
DO i = 1, m
WRITE(503,*) i_2d(i,1:n); CALL FLUSH(503)
END DO
DO i = 1, m
DO j = 1, n
IF (abs(r_2d(i,j))>1.0E-5 .or. ABS(i_2d(i,j))>1.0E-5) &
WRITE(6,*) i,j,r_2d(i,j),i_2d(i,j)
END DO
END DO
plan = FFTW_PLAN_DFT_C2R_2D(n, m, fmn_2d, func_2d, FFTW_ESTIMATE)
CALL FFTW_EXECUTE_DFT_C2R(plan, fmn_2d, func_2d)
CALL FFTW_DESTROY_PLAN(plan)
DO i = 1, m
WRITE(504,*) func_2d(i,1:n)/norm2; CALL FLUSH(504)
END DO
CALL FFTW_FREE(real_2d)
CALL FFTW_FREE(complex_2d)
IF (ASSOCIATED(fmn_1d)) DEALLOCATE(fmn_1d)
END PROGRAM FFTW_TEST
Now I'd like to extract the harmonics of a function which looks like:
$A_{mn} \cos(m\theta+n\phi)$, where $\theta$ and $\phi$ are the real-space grid. First, taking the real part of the complex array appears to be correct. The harmonics seem correct for simple functions. However, in the final test case it seems that the array has an odd ordering. Here's the ordering
m/n
0/0 1/0 2/0 3/0 4/0 5/0 6/0 7/0 8/0 0/1 1/1 2/1 3/1 4/1 5/1 6/1
7/1 8/1 0/2 1/2 2/2 3/2 4/2 5/2 6/2 7/2 8/2 0/3 1/3 2/3 3/3 4/3
5/3 6/3 7/3 8/3 0/4 1/4 2/4 3/4 5/4 6/4 7/4 8/4 ?/? ?/? ?/? ?/?
For reference here's what I'd expect the ordering to look like:
m/n
0/0 1/0 2/0 3/0 4/0 5/0 6/0 7/0 8/0 -7/0 -6/0 -5/0 -4/0 -3/0 -2/0 -1/0
0/1 1/1 2/1 3/1 4/1 5/1 6/1 7/1 8/1 -7/1 -6/1 -5/1 -4/1 -3/1 -2/1 -1/1
0/2 1/2 2/2 3/2 4/2 5/2 6/2 7/2 8/2 -7/2 -6/2 -5/2 -4/2 -3/2 -2/2 -1/2
It seems like the code is just treating the array like a linear array. But what what I can read in the FFTW documentation this should not be the case. One dimension of the array should correspond to the transforms along one dimension and the other the other. Thus in some sense we should be able to read off m and n harmonics.
Can someone explain how the complex array should be ordered in terms of harmonics and the proper normalizations?
I am trying to simulate harmonic oscillator by using Verlet Method(Original Verlet) in Fortran.
My research tells that the order of error should be 2 but my calculation showed the order of 1.
I couldn't find my mistake in my source code. What should I do?
Edit:
The algorithm I am using is below:
x(t+Δt) = 2x(t) - x(t-Δt) + Δt² F(t)/m
v(t) = {x(t+Δt) -x(t-Δt)}/2Δt
Where x(t) represents the position, v(t) represents velocity and F(t) represents Force. I recognize this is the Original Verlet described here
According to this site, the order of error should be at least O(Δt²) but the error of the order of my program plotted in gnuplot (below) does not have a order of O(Δt²).
program newton_verlet
implicit none
real*16, parameter :: DT = 3.0
real*16, parameter :: T0 = 0.0
real*16, parameter :: TEND = 2.0
integer, parameter :: NT = int(TEND/DT + 0.5)
real*16, parameter :: M = 1.0
real*16, parameter :: X0 = 1.0
real*16, parameter :: V0 = 0.0
real*16 x,v,t,xold,xnew,vnew,ek,ep,et,f,h
integer it,n
do n=0,20
h = DT/2**n
x = X0
v = V0
ek = 0.5*M*v*v
ep = x*x/2
et = ek + ep
xold = x - v*h
do it = 1,2**n
! f = -x
f = -x
xnew = 2.0*x - xold + f*h*h/M
v = (xnew-xold)/(2.0*h)
ek = 0.5*M*v*v
ep = 0.5*xnew*xnew
et = ek + ep
xold = x
x = xnew
end do
write(*,*) h,abs(x-cos(DT))+abs(v+sin(DT))
end do
end program
Above program calculates the error of calculation for the time step h.
According to the Wiki page for Verlet integrators, it seems that we need to use a more accurate way of setting the initial value of xold (i.e., include terms up to the force) to get the global error of order 2. Indeed, if we modify xold as
program newton_verlet
implicit none
real*16, parameter :: DT = 3.0
real*16, parameter :: M = 1.0
real*16, parameter :: X0 = 1.0
real*16, parameter :: V0 = 0.0
real*16 x,v,xold,xnew,f,h
integer it,n
do n = 0, 20
h = DT / 2**n
x = X0
v = V0
f = -x
! xold = x - v * h !! original
xold = x - v * h + f * h**2 / (2 * M) !! modified
do it = 1, 2**n
f = -x
xnew = 2 * x - xold + f * h * h / M
xold = x
x = xnew
end do
write(*,*) log10( h ), log10( abs(x - cos(DT)) )
end do
end program
the global error becomes of order 2 (please see the log-log plot below).
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.
For some reason it never interpolates, but it gives 0 as an answer. The code is:
PROGRAM LAGRANGE
REAL X(0:100), Y(0:100), INTERP
REAL TEMP = 1.0
REAL POLINOM = 0.0
N=10
OPEN(1,FILE="datos.txt")
DO I=0,100 !We 'clean' the arrays: all positions are 0
X(I)=0.0
Y(I)=0.0
END DO
DO I=0,10 !We read the data file and we save the info
READ(1,*) X(I), Y(I)
END DO
CLOSE(1)
WRITE(*,*) "Data table:"
DO I=0,10
WRITE(*,*) X(I), Y(I)
END DO
WRITE(*,*) "Which value of X do you want to interpolate?"
READ(*,*) INTERP
DO I=0,N
DO J=0,N
IF(J.NE.I) THEN !Condition: J and I can't be equal
TEMP=TEMP*(INTERP-X(J))/(X(I)-X(J))
ELSE IF(J==I) THEN
TEMP=TEMP*1.0
ELSE
END IF
END DO
POLINOM=POLINOM+TEMP
END DO
WRITE(*,*) "Value: ",POLINOM
STOP
END PROGRAM
Where did I fail? I basically need to implement this:
Lagrange interpolation method
Thanks a lot in advance.
In addition to the "symbol-concatenation" problem (explained in the other answer), it seems that TEMP needs to be reset to 1.0 for every I (to calculate the Lagrange polynomial for each grid point), plus we need to multiply it by the functional value on that point (Y(I)). After fixing these
PROGRAM LAGRANGE
implicit none !<-- always recommended
REAL :: X(0:100), Y(0:100), INTERP, TEMP, POLINOM
integer :: I, J, K, N
N = 10
X = 0.0
Y = 0.0
!! Test data (sin(x) over [0,2*pi]).
DO I = 0, N
X(I) = real(I) / real(N) * 3.14159 * 2.0
Y(I) = sin( X(I) )
END DO
WRITE(*,*) "Data table:"
DO I = 0, N
WRITE(*,*) X(I), Y(I)
END DO
interp = 0.5 !! test value
POLINOM = 0.0
DO I = 0, N
TEMP = 1.0 !<-- TEMP should be reset to 1.0 for every I
DO J = 0, N
IF( J /= I ) THEN
TEMP = TEMP * (interp - X(J)) / (X(I) - X(J))
END IF
END DO
TEMP = TEMP * Y(I) !<-- also needs this
POLINOM = POLINOM + TEMP
END DO
print *, "approx : ", POLINOM
print *, "exact : ", sin( interp )
end
we get a pretty good agreement between the approximate (= interpolated) and exact results:
Data table:
0.00000000 0.00000000
0.628318012 0.587784827
1.25663602 0.951056182
1.88495409 0.951056957
2.51327205 0.587786913
3.14159012 2.53518169E-06
3.76990819 -0.587782800
4.39822626 -0.951055467
5.02654409 -0.951057792
5.65486193 -0.587789178
6.28318024 -5.07036339E-06
approx : 0.479412317
exact : 0.479425550
Consider the (complete) program
real x = 1.
end
What does this do?
If this is free-form source then it is an invalid program. If it is fixed-form source then it is a valid program.
In fixed-form source, spaces after column 6 largely have no effect. The program above is exactly like
realx=1.
end
and we can see that we're just setting an implicitly declared real variable called realx to have value 1..
implicit none
real x = 1.
end
will show a problem.
In free-form source, initialization in a declaration statement requires ::, like so:
real :: x = 1.
end
And: use implicit none.
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.