I'm working on a Bi-Conjugate Gradient algorithm in Fortran and have it fully code, following the algorithm in Saad, Y. "Iterative Methods for Sparse Linear Systems" (the plain BiCG method). However, it is not converging in the required number of iterations, nor is it returning the correct results.
The algorithm is given as in the "Unpreconditioned version" on Wikipedia (http://en.wikipedia.org/wiki/Biconjugate_gradient_method#Unpreconditioned_version_of_the_algorithm)
I am still relatively new to Fortran, and do not understand why exactly this is not behaving as expected because as far as I know its coded exactly as specified. If someone sees any unorthodox code, or faults in the algorithm I would be very grateful!
I have included a test matrix for simplicity:
!
!////////////////////////////////////////////////////////////////////////
!
! BiCG_main.f90
! Created: 19 February 2013 12:01
! By: Robin Fox
!
!////////////////////////////////////////////////////////////////////////
!
PROGRAM bicg_main
!
IMPLICIT NONE
!-------------------------------------------------------------------
! Program to implement the Bi-Conjugate Gradient method
! follows algorithm in Saad
!-------------------------------------------------------------------
!
COMPLEX(KIND(0.0d0)), DIMENSION(:,:), ALLOCATABLE ::A
COMPLEX(KIND(0.0d0)), DIMENSION(:), ALLOCATABLE ::b
COMPLEX(KIND(0.0d0)), DIMENSION(:), ALLOCATABLE ::x0, x0s
COMPLEX(KIND(0.0d0)), DIMENSION(:), ALLOCATABLE ::x, xs
COMPLEX(KIND(0.0d0)), DIMENSION(:), ALLOCATABLE ::p, ps
COMPLEX(KIND(0.0d0)) ::alpha, rho0, rho1, r_rs
COMPLEX(KIND(0.0d0)), DIMENSION(:), ALLOCATABLE ::r,rs, res_vec
COMPLEX(KIND(0.0d0)), DIMENSION(:), ALLOCATABLE ::Ax, ATx
COMPLEX(KIND(0.0d0)), DIMENSION(:), ALLOCATABLE ::Ap, Aps
COMPLEX(KIND(0.0d0)) ::beta
!
REAL(KIND(0.0d0)) ::tol,res, n2b, n2r0, rel_res
!
INTEGER ::n,i,j,k, maxit
!////////////////////////////////////////////////////////////////////////
!----------------------------------------------------------
n=2
ALLOCATE(A(n,n))
ALLOCATE(b(n))
A(1,1)=CMPLX(-0.73492,7.11486)
A(1,2)=CMPLX(0.024839,4.12154)
A(2,1)=CMPLX(0.274492957,3.7885537)
A(2,2)=CMPLX(-0.632557864,1.95397735)
b(1)=CMPLX(0.289619736,0.895562183)
b(2)=CMPLX(-0.28475616,-0.892163111)
!----------------------------------------------------------
ALLOCATE(x0(n))
ALLOCATE(x0s(n))
!Use all zeros initial guess
x0(:)=CMPLX(0.0d0,0.0d0)
DO i=1,n
x0s(i)=CONJG(x0(i))
END DO
ALLOCATE(Ax(n))
ALLOCATE(ATx(n))
ALLOCATE(x(n))
ALLOCATE(xs(n))
! Multiply matrix A with vector x0
DO i=1,n
Ax(i)=CMPLX(0.0,0.0)
DO j=1,n
Ax(i)=Ax(i)+A(i,j)*x0(j) !==Ax=A*x0
END DO
END DO
! Multiply matrix A^T with vector x0
DO i=1,n
ATx(i)=CMPLX(0.0,0.0)
DO j=1,n
ATx(i)=ATx(i)+CONJG(A(j,i))*x0s(j) !==A^Tx=A^T*x0
END DO
END DO
res=0.0d0
n2b=0.0d0
x=x0
ALLOCATE(r(n))
ALLOCATE(rs(n))
ALLOCATE(p(n))
ALLOCATE(ps(n))
!Initialise
DO i=1,n
r(i)=b(i)-Ax(i)
rs(i)=CONJG(b(i))-ATx(i)
p(i)=r(i) !p0=r0
ps(i)=rs(i) !p0s=r0s
END DO
DO i=1,n
n2b=n2b+(b(i)*CONJG(b(i)))
res=res+(r(i)*CONJG(r(i))) !== inner prod(r,r)
END DO
n2b=SQRT(n2b)
res=SQRT(res)/n2b
!Check that inner prod(r,rs) =/= 0
n2r0=0.0d0
DO i=1,n
n2r0=n2r0+r(i)*CONJG(rs(i))
END DO
IF (n2r0==0) THEN
res=1d-20 !set tol so that loop doesn't run (i.e. already smaller than tol)
PRINT*, "Inner product of r, rs == 0"
END IF
WRITE(*,*) "n2r0=", n2r0
!----------------------------------------------------------
ALLOCATE(Ap(n))
ALLOCATE(Aps(n))
ALLOCATE(res_vec(n))
tol=1d-6
maxit=50 !for n=720
k=0
!Main loop:
main: DO WHILE ((res>tol).AND.(k<maxit))
k=k+1
! Multiply matrix A with vector p
DO i=1,n
Ap(i)=CMPLX(0.0,0.0)
DO j=1,n
Ap(i)=Ap(i)+A(i,j)*p(j)
END DO
END DO
! Multiply matrix A^T with vector p
! N.B. transpose is also conjg.
DO i=1,n
Aps(i)=CMPLX(0.0,0.0)
DO j=1,n
Aps(i)=Aps(i)+CONJG(A(j,i))*ps(j)
END DO
END DO
rho0=CMPLX(0.0d0,0.0d0)
DO i=1,n
rho0=rho0+(r(i)*CONJG(rs(i)))
END DO
WRITE(*,*) "rho0=", rho0
rho1=CMPLX(0.0d0,0.0d0)
DO i=1,n
rho1=rho1+(Ap(i)*CONJG(ps(i)))
END DO
WRITE(*,*) "rho1=", rho1
!Calculate alpha:
alpha=rho0/rho1
WRITE(*,*) "alpha=", alpha
!Update solution
DO i=1,n
x(i)=x(i)+alpha*p(i)
END DO
!Update residual:
DO i=1,n
r(i)=r(i)-alpha*Ap(i)
END DO
!Update second residual:
DO i=1,n
rs(i)=rs(i)-alpha*Aps(i)
END DO
!Calculate beta:
r_rs=CMPLX(0.0d0,0.0d0)
DO i=1,n
r_rs=r_rs+(r(i)*CONJG(rs(i)))
END DO
beta=r_rs/rho0
!Update direction vectors:
DO i=1,n
p(i)=r(i)+beta*p(i)
END DO
DO i=1,n
ps(i)=rs(i)+beta*ps(i)
END DO
!Calculate residual for convergence check
! res=0.0d0
! DO i=1,n
! res=res+(r(i)*CONJG(r(i))) !== inner prod(r,r)
! END DO
!----------------------------------------------------------
!Calculate updated residual "res_vec=b-A*x" relative to current x
DO i=1,n
Ax(i)=CMPLX(0.0d0, 0.0d0)
DO j=1,n
Ax(i)=Ax(i)+A(i,j)*x(j)
END DO
END DO
DO i=1,n
res_vec(i)=b(i)-Ax(i)
END DO
DO i=1,n
rel_res=rel_res+(res_vec(i)*CONJG(res_vec(i)))
END DO
res=SQRT(res)/REAL(n2b)
WRITE(*,*) "res=",res
WRITE(*,*) " "
END DO main
!----------------------------------------------------------
!Output message
IF (k<maxit) THEN
WRITE(*,*) "Converged in",k,"iterations"
ELSE
WRITE(*,*) "STOPPED after",k, "iterations because max no. of iterations was reached"
END IF
!Output solution vector:
WRITE(*,*) "x_sol="
DO i=1,n
WRITE(*,*) x(i)
END DO
!----------------------------------------------------------
DEALLOCATE(x0,x0s, Ax, ATx, x, xs, p, ps ,r, rs, Ap, Aps, res_vec)
DEALLOCATE(A,b)
!
END PROGRAM
!
!////////////////////////////////////////////////////////////////////////
RESULTS: The results to my script are given as:
STOPPED after 50 iterations because max no. of iterations was reached
x_sol=
(-2.88435711452590705E-002,-0.43229898544084933 )
( 0.11755325208241280 , 0.73895038053993978 )
while the actual results are given using MATLAB's built in bicg.m function as:
-0.3700 - 0.6702i
0.7295 + 1.1571i
Here are some blemishes on your program. Whether they are errors or not is somewhat subjective and it's entirely up to you whether you modify your code.
In this line
IF (n2r0==0) THEN
you test whether the result of a (possibly long running) loop sums
to exactly 0. This is always a bad idea with floating-point
numbers. If you do not know this, review the many, many questions
here on SO with the tag floating-point which arise from widespread
imprecision in understanding of what it is reasonable to expect from
f-p arithmetic. I don't think your use of a real number on the left and an integer on the right of the comparison makes matters worse, but it doesn't make them any better.
In at least two places in your code you calculate matrix-vector products. You could replace those loops with calls to the intrinsic matmul routine (I think, I haven't checked your code as closely as I'm sure you have). This might actually slow your code, but that's not the problem at this stage. Calling a well-tested library routine rather than rolling your own will (a) reduce the amount of code you have to maintain/test/fix and (b) be more likely to deliver a right-first-time solution. Once you have the code working then, if you must, worry about performance.
You declare many real and complex variables with double precision but
initialise them with statements like:
A(1,1)=CMPLX(-0.73492,7.11486)
A double precision variable has about 15 decimal digits available,
but here you provide values for only the first 6 of them. You
cannot rely on the compiler to set the other digits to any
particular values. Instead, initialise like this:
A(1,1)=CMPLX(-0.73492_dp,7.11486_dp)
which will result in those values being initialised to the double
precision numbers closest to -0.73492 and 7.11486. Of course, you have to have previously written something like dp = kind(0d0), and there are other ways of enforcing the precision of literal constants, but this is the way I usually do it. If you have a modern Fortran compiler which provides the intrinsic iso_fortran_env module you could replace the _dp with the now-standard _real64.
This block of code
x0(:)=CMPLX(0.0d0,0.0d0)
DO i=1,n
x0s(i)=CONJG(x0(i))
END DO
could be replaced by
x0 = CMPLX(0.0d0,0.0d0)
x0s = x0
It seems a little peculiar to use the array syntax to zero the first
array, then a loop to zero the second; it seems even more peculiar
to call CONJG repeatedly when CONJG(0,0)==(0,0).
This block of code
DO i=1,n
n2b=n2b+(b(i)*CONJG(b(i)))
res=res+(r(i)*CONJG(r(i))) !== inner prod(r,r)
END DO
n2b=SQRT(n2b)
res=SQRT(res)/n2b
can, if I understand correctly, be replaced by
n2b = sqrt(dot_product(b,b))
res = sqrt(dot_product(r,r))/n2b
I don't actually see anything wrong with your code here, but using the intrinsics cuts down the number of lines you need to write and to maintain as in the case of matmul above.
There may be other, less immediately evident, blemishes, but this lot should get you started.
Related
I am translating a Matlab code into Fortran 90 and am trying to translate the following piece of code:
func= inline('x+ y+ z', 'x', 'y', 'z')
x(1)= 1, y(1)= 1, z(1)= 1
for n= 1:5
output= 5+ func(x(n), y(n), z(n))
x(n+ 1)= x(n)+ 1
y(n+ 1)= y(n)+ 1
z(n+ 1)= z(n)+ 1
end
In Fortran I am using the statement (inline) function as func(x, y, z)= x+ y+ z, however, I am not able to insert the array part into the function.
How can I negotiate the dependence on 'n' into the statement function? I am trying something like the following but am not quite there yet.
func(x, y, z)= x+ y+ z
x(1)= 1, y(1)= 1, z(1)= 1
do n= 1, 5
func(x(n), y(n), z(n))= x(n)+ y(n)+ z(n)
end
Any help would be greatly appreciated.
This is an extended and formatted comment rather than an answer.
The general advice with statement functions in modern Fortran is Don't, just don't. They're not big and they're not clever. They were also deprecated in, I think, the Fortran 90 standard so, to be pedantic, your requirements are inconsistent.
Beyond that, it's difficult to provide any specific advice. If I understand the Matlab correctly the code you show is a convoluted way to calculate 5+3*1+3*2+...+3*5. In Fortran 90 you might write
sum([5, (3*k,k=1,5)])
to calculate that.
Perhaps if we knew more of the context of your problem we'd be able to provide better advice.
I did realize that statement functions in modern Fortran is not the way to go. Instead I have created subroutines for the functions and then call them in the loop. This way all the values of the function in the loop can be put into an array (instead of just the last values). The correct piece of code looks like this:
subroutine funcsub(func, x, y, z, funcn)
implicit none
real, dimension(funcn), intent(out) :: func
real, dimension(funcn), intent(in) :: x, y, z
integer, intent(in) :: funky
func= x+ y+ z
end subroutine funcsub
do i= 1, 5
funcn= size(func)
call funcsub(func, x(i), y(i), z(i), funcn)
x(i+ 1)= x(i)+ 1
y(i+ 1)= y(i)+ 1
z(i+ 1)= z(i)+ 1
end do
I am trying to solve
argmin||W_vector*FT^-1(Ax)-W_vector*B||
using lsqr with a function handle and without any initial guess (W_vector is a weighting vector). I thought that lsqr would have performed the first step computing x by C'b (call C=W*FT^-1(A)) using the vector b=W_vector.*B I passed to the function. This is the code:
b=W_vector.*B;
[x, flag]=lsqr(#(x1,modo)FUNC(x1,W_vector,A,modo),b,tol,maxit);
function [result, modo]=FUNC(x1,W_vector,A,modo)
%Computes y=A*x for modo='notransp'
%Computes y=A'*x for modo='transp'
switch modo
case 'notransp'
res=A*x1;
R1=reshape(res,norient,dim(1)*dim(2)*dim(3));
for co=1:norient
R2(:,:,:,co)=reshape(R1(co,:),dim(1),dim(2),dim(3));
FR(:,:,:,co)=ifftn(R2(:,:,:,co));
aux=FR(:,:,:,co);
R3(co,:)=aux(:).';
end
result=W_vector.*R3(:);
case 'transp'
R1=reshape(x1./(W_vector+eps),norient,dim(1)*dim(2)*dim(3));
for co=1:norient
R2(:,:,:,co)=reshape(R1(co,:),dim(1),dim(2),dim(3));
FR(:,:,:,co)=fftn(R2(:,:,:,co));
aux=FR(:,:,:,co);
R3(co,:)=aux(:).';
end
result=A'*R3(:);
end
end
When I checked the result of R1=reshape(x1./(W_vector+eps),norient,dim(1)*dim(2)*dim(3)); in case 'transp' in the first iteration, I found out that x1 is not equal to b (after reshape, they are images, so I can see that look qualitatively the same but with very different values). I would like to understand how lsqr works because I am having some problems with weightings. Thanks for your help.
I am trying out the questions in programming assignment of Coursera course on Matlab programming as an exercise. This is my Question:
Write a function called sort3 that takes three scalar arguments. It uses if-statements, possibly nested, to
return the three values of these arguments in a single row-vector in increasing order (or more precisely,
non-decreasing order), i.e., element one of the output vector equals the smallest input argument and
element three of the output vector equals the largest input argument.
Here is my code:
function sv = sort3(x,y,z)
if nargin < 3
error('must have at least three input argument');
else
if ~isscalar(x) || x ~= fix(x)
error('x needs to be a scalar');
end
if ~isscalar(y) || y ~= fix(y)
error('y needs to be a scalar');
end
if ~isscalar(z) || z ~= fix(z)
error('z needs to be a scalar');
end
end
a=x;
b=y;
c=z;
if a >= b
t=a;
a=b;
b=t;
end
if b >= c
t=b;
b=c;
c=t;
end
if a >= b
t=a;
a=b;
b=t;
end
if nargout == 1
sv=[a b c];
end
I got the below result on Matlab.
Problem 3 (sort3):
Feedback: Your program made an error for argument(s) -1.3719900292403, -0.639443998445333, 1.04704952581735
Please help me.
Thanks.
When you compare x with fix(x) your program moves to the command error that you have written.
When you pass to your function a decimal number, obviously x is always not equal to fix(x) and then your function will always end with an error.
If you want to work only with scalars or integers, you can think to apply function fix to your input before to start with your algorithm.
I am running a matlab code in order to solve a matrix in an iterative way, I am trying to solve x=A\b in every iteration until x --> 0 by changing A and b, in the first 3 iterations work fine until I reach a point where I start getting imaginary numbers in my solution.
Here is my code:
Q,H,n,R are predefined variables.
while(eps > 10^-6)
i=1;j=1;
while(i<11)
A11(i,j) = 1.852*R(i)*(abs(Q(i)))^(n-1);
i=i+1;
j=j+1;
end
A11(11,11) = 2*R(11)*abs(Q(11));
%calculate -dE & dq
dE = [200-H(1)-R(1)*Q(1)^1.852
H(1)-H(2)- R(2)*Q(2)^1.852
H(1)-H(3)-R(3)*Q(3)^1.852
H(2)-H(7)-R(4)*Q(4)^1.852
H(6)-H(5)-R(5)*Q(5)^1.852
H(7)-H(4)-R(6)*Q(6)^1.852
H(6)-H(7)-R(7)*(Q(7))^1.852
H(5)-H(4)-R(8)*Q(8)^1.852
H(3)-H(2)-R(9)*Q(9)^1.852
H(3)-H(4)-R(10)*Q(10)^1.852
0-H(3)+240- R(11)*Q(11)];
dq = [-Q(1)+Q(2)+Q(3)
-Q(2)-Q(9)+Q(4)+4
-Q(11)+Q(9)+Q(10)+6
-Q(10)-Q(6)-Q(8)+5
-Q(5)+Q(8)+5
-Q(3)+Q(7)+Q(5)+5
-Q(4)-Q(7)+Q(6)+3];
%formulate the full set of equations
zero=zeros(nn,nn);
b=[dE;dq];
upA = [A11,A12];
downA=[A21,zero];
A= [upA;downA];
%solve the equations (x=A\b)
x = A\b;
%update Q and H
i=1;j=1;
while (i<8 && j<12)
H(i)= x(11+i)+ H(i);
Q(j)= x(j)+ Q(j);
i=i+1;
j=j+1;
end
%check stopping criteria
j=1;sumeps=0;
while (j<12)
sumeps=sumeps+x(j);
j=j+1;
end
epscal = sumeps/12;
eps=abs(epscal)
end
I realized that i start getting problems when one of the values of vector Q turns negative, and when that value is raised to the power of 1.852 (while calculating dE) it gives an imaginary number!!
Maybe someone knows whre
That's correct. (-1)^N has an imaginary component whenever N has a fractional component.
Most obviously, (-1)^0.5 is just i.
It's not the fact hat the power is bigger than 1, it's the fact that the power is not an integer (i.e. X^2, X^3, ...). Imagine X^0.5 which equals sqrt(X). Obviously that yields an imaginary number for negative values of X.
Once again I have a problem with the Gauss-Seidel Method in Matlab. Here it is:
function [x] = ex1_3(A,b)
format long
sizeA=size(A,1);
x=zeros(sizeA,1);
%Just a check for the conditions of the Gauss-Seidel Method (if it has dominant diagonal)
for i=1:sizeA
sum=0;
for j=1:sizeA
if i~=j
sum=sum+abs(A(i,j));
end
end
if abs(A(i,i))<sum
fprintf('\nGauss-Seidel''s conditions not met!\n');
return
end
end
%Actual Gauss-Seidel Method
max_temp=10^(-6); %Pass first iteration
while max_temp>(0.5*10^(-6))
xprevious=x;
for i=1:sizeA
x(i,1)=b(i,1);
for j=1:sizeA
if i~=j
x(i,1)=x(i,1)-A(i,j)*x(j,1);
end
end
x(i,1)=x(i,1)/A(i,i);
end
x
%Calculating infinite norm of vector x-xprevious
temp=x-xprevious;
max_temp=temp(1,1);
for i=2:sizeA
if abs(temp(i,1))>max_temp
max_temp=abs(temp(i,1));
end
end
end
It actually works fine for a 100x100 matrix or smaller. However, my tutor wants it to work for 100000x100000 matrices. At first it was difficult to even create the matrix itself, but I managed to do it with a little help from here:
Matlab Help Center
Now, I call the ex1_3 function with A as a parameter, but it goes really slow. Actually it never ends. How can I make it work?
Here's my code for creating the specific matrix my tutor wanted:
The important part is just that it meets these conditions:
A(i; i) = 3, A(i - 1; i) = A(i; i + 1) = -1 n=100000
b=ones(100000,1);
b(1,1)=2;
b(100000,1)=2;
i=zeros(299998,1); %Matrix with the lines that we want to put nonzero elements
j=zeros(299998,1); %Matrix with the columns that we want to put nonzero elements
s=zeros(299998,1); %Matrix with the nonzero elements.
number=1;
previousNumberJ=0;
numberJ=0;
for k=1:299998 %Our index in i and j matrices
if mod((k-1),3)==0
s(k,1)=3;
else
s(k,1)=-1;
end
if k==1 || k==2
i(k,1)=1;
j(k,1)=k;
elseif k==299997 || k==299998
i(k,1)=100000;
j(k,1)=(k-200000)+2;
else
if mod(k,3)==0
number=number+1;
numberJ=previousNumberJ+1;
previousNumberJ=numberJ;
end
i(k,1)=number;
j(k,1)=numberJ;
numberJ=numberJ+1;
end
end
A=sparse(i,j,s); %Creating the sparse array
x=ex1_3(A,b);
the for loop works very slowly in Matlab, perhaps you may want to try the matrix form of the iteration:
function x=gseidel(A,b)
max_temp=10^(-6); %Pass first iteration
x=b;
Q=tril(A);
r=b-A*x;
for i=1:100
dx=Q\r;
x=x+1*dx;
r=b-A*x;
% convergence check
if all(abs(r)<max_temp) && all(abs(dx)<max_temp), return; end
end
For your A and b, it only takes 16 steps to converge.
tril extracts the lower triangular part of A, you can also obtain this Q when you build up the matrix. Since Q is already the triangular matrix, you can solve the equation Q*dx=r very easily if you are not allowed to use \ function.