I have simple Fortran code which convert the A=[1,1;1,1] matrix to CSR sparse format and then multiply it with x=(100,200) as a vector, y=A*x.
Unfortunately the result is strange y=(200,200) while it should be y =(300,300) vector. Thanks.
program main
implicit none
include 'mkl_spblas.fi'
integer :: nzmax, nnz, job( 8 ), m, n, lda, info, irow, k
double precision :: A(2,2)
double precision, allocatable :: Asparse(:)
integer, allocatable :: ia(:), ja(:)
double precision:: x(2)
double precision:: y(2)
A(1,1) = 1.d0
A(1,2) = 1.d0
A(2,1) = 1.d0
A(2,2) = 1.d0
x(1) = 100.d0
x(2) = 200.d0
!! Give an estimate of the number of non-zeros.
nzmax = 4
print *, "nzmax = ", nzmax
m = size( A, 1 ) !! number of rows
n = size( A, 2 ) !! number of columns
lda = m !! leading dimension of A
allocate( Asparse( nzmax ) )
allocate( ja( nzmax ) ) !! <-> columns(:)
allocate( ia( m + 1 ) ) !! <-> rowIndex(:)
job( 1 ) = 0 !! convert dense to sparse A
job( 2:3 ) = 1 !! use 1-based indices
job( 4 ) = 2 !! use the whole A as input
job( 5 ) = nzmax !! maximum allowed number of non-zeros
job( 6 ) = 1 !! generate Asparse, ia, and ja as output
call mkl_ddnscsr( job, m, n, A, lda, Asparse, ja, ia, info )
if ( info /= 0 ) then
print *, "insufficient nzmax (stopped at ", info, "row)"; stop
endif
nnz = ia(m+1)
print *, "number of non-zero elements = ", nnz
do irow = 1, m
!! This loop runs only for rows having nonzero elements.
do k = ia( irow ), ia( irow + 1 ) - 1
print "(2i5, f15.8)", irow, ja( k ), Asparse( k )
enddo
enddo
call mkl_cspblas_dcsrgemv('n', m, Asparse, ia, ja, x, y)
print*, y
end program
that's because you are using a c-style indexing for calling MKL subroutine.
mkl_cspblas_dcsrgemv is zero-based indexing.
for your program you should use mkl_dcsrgemv which is one-based indexing.
Related
I tried this in fortran.
The initial array is zeros, for example:
InitialMatrix = 0 0
0 0
0 0
0 0
And I want to add numbers 1 sequentially:
FinalMatrix = 0 0
0 1
1 0
1 1
As if adding one bit at a time.
I generated a matrix containing all elements equal to zero and tried to use ibset to change the zero element to 1, but without success.
The code I made was this one:
program test
implicit none
integer(1) numSitio
integer:: Comb
integer:: i, j
integer, dimension(10, 10)::MatrixZeros
integer, dimension(10, 10)::MatrixSpins
print*, "Set the number of sites: "
read(*,*)numSitio
Comb = 2**numSitio
MatrixZeros = 0
MatrixSpins = ibset(MatrixZeros, 1)
do i = 1, Comb
do j = 1, numSitio
MatrixSpins(i,j) = 0
end do
end do
do i = 1, Comb
write(*,*)(MatrixSpins(i,j), j= 1, numSitio)
end do
!write(*,*)MatrixZeros
end program test
I generated a matrix of zeros to be auxiliary, and then I created the matrix of spins that I want. I tried using the ibset command to add numbers 1 to zero array.
Note: I want to generate a matrix with n columns and 2^n rows, where the first row is all zero elements and starting from the second row, add a 1 bit in the last column. In the third line, the rightmost bit (last column, move to the left column and go on adding bits 1 until in the last line of the matrix, all elements are 1.
If you simply want to count in binary, then just
program test
implicit none
integer i, n
character fmt
print *, "Input number of bits: "; read *, n
write( fmt, "( i0 )" ) n
print "( b0." // fmt // " )", ( i, i = 0, 2 ** n - 1 )
end program test
If you absolutely have to store all the configurations in a matrix (an array of characters would be just as good) then you can just count up with traditional "carry" operations:
program test
implicit none
integer i, j, imx, jmx
integer n
integer, allocatable :: M(:,:)
print *, "Input number of bits: "; read *, n
imx = 2 ** n - 1; jmx = n - 1
allocate( M(0:imx, 0:jmx) )
M = 0
do i = 1, imx
M(i,:) = M(i-1,:)
M(i,jmx) = M(i,jmx) + 1
j = jmx
do while ( M(i,j) > 1 ) ! "carry" operations
M(i,j) = 0
j = j - 1
M(i,j) = M(i,j) + 1
end do
end do
do i = 0, imx
print "( *( i1, 1x ) )", M(i,:)
end do
end program test
or you could use bit operations:
program test
implicit none
integer i, j, imx, jmx, p
integer n
integer, allocatable :: M(:,:)
print *, "Input number of bits: "; read *, n
imx = 2 ** n - 1; jmx = n - 1
allocate( M(0:imx, 0:jmx) )
M = 0
p = 1
do j = 0, jmx
do i = 0, imx
if ( iand(i,p) > 0 ) M(i,jmx-j) = 1
end do
p = 2 * p
end do
do i = 0, imx
print "( *( i1, 1x ) )", M(i,:)
end do
end program test
I want to calculate A*x with A lower triangle matrix and x the vector. For example:
1 0 0
A = 2 4 0
3 5 6
with packed storage
A = (/ 1, 2, 3, 4, 5, 6/)
and
X = (/1, 1, 1/)
Now I want to do A*x with BLAS function, shoud I tranform A back to be a 3x3 matrix? If not, could you please give me some hint? (I know in memory of fortran array, A is contiguously stored)
solved by checking: http://www.icl.utk.edu/~mgates3/docs/lapack.html
program main
implicit none
integer :: n
real*8, allocatable, dimension(:) :: x
real*8, allocatable, dimension(:) :: A
n = 3
allocate(A(n*(n+1)/2))
allocate(x(n))
A = 1.0d0
x = 1.0d0
! x will be updated as A*x
call dtpmv('L', 'N', 'N', n, A, x, 1)
deallocate(A)
deallocate(x)
end program main
This is my code:
Program Arrays_0
Implicit none
Integer :: i , Read_number , Vig_Position , Vipg_Position , n_iter
Integer , parameter :: Br_gra = 12
Integer , parameter , dimension ( Br_gra ) :: Vig = [ ( i , i = 1 , Br_gra) ]
Integer , parameter , dimension ( Br_gra ) :: Vipg = [ 0 , 1 , 1 , 1 , 2 , 2 , 3 , 4 , 4 , 7 , 7 , 7 ]
Integer :: Result_of_calculation
Write(*,*)"Enter the number (From 1 to Br_gra):"
Read(*,*) Read_number
Vig_Position = Vig(Read_number)
Vipg_Position = Vipg(Vig_Position)
n_iter = 0
Result_of_calculation = Vig_Position
Do while( Vipg_Position .ne. Vipg(1) )
n_iter = n_iter + 1
Vig_Position = Vipg_Position
Result_of_calculation = Result_of_calculation + Vig_Position
Vipg_Position = Vipg(Vig_Position)
End Do
Write(*,'(a,1x,i0)')"The number of iteration is:",n_iter
Write(*,'(a,1x,i0)')"The result of calculation is:",Result_of_calculation
End Program Arrays_0
Intention is to get value in every iteration for a variables:
Vig_Position , Result_of_calculation and Vipg_position.
How to declare variables for that kind of calculation?
In general, is there other method for counting a number of iteration?
How to declare variables in function of number of iteration befoure the code set that number like result of calculation?
Now that the question has been clarified, here's a typical way of solving the problem in Fortran. It isn't the only possible way, but it is the most general. The strategy in routine resize to double the old size is reasonable - you want to minimize the number of times this is called. The data set in the sample program is small, so to show the effect I allocated the array very small to begin with. In reality, you would want a reasonably large initial allocation (say, 100 at least).
Note the use of an internal procedure that inherits the type vals_t from its host.
Program Arrays_0
Implicit none
Integer :: i , Read_number , Vig_Position , Vipg_Position , n_iter
Integer , parameter :: Br_gra = 12
Integer , parameter , dimension ( Br_gra ) :: Vig = [ ( i , i = 1 , Br_gra) ]
Integer , parameter , dimension ( Br_gra ) :: Vipg = [ 0 , 1 , 1 , 1 , 2 , 2 , 3 , 4 , 4 , 7 , 7 , 7 ]
Integer :: Result_of_calculation
! Declare a type that will hold one iteration's values
type vals_t
integer Vig_Position
integer Vipg_Position
integer Result_of_calculation
end type vals_t
! Declare an allocatable array to hold the values
! Initial size doesn't matter, but should be close
! to a lower limit of possible sizes
type(vals_t), allocatable :: vals(:)
allocate (vals(2))
Write(*,*)"Enter the number (From 1 to Br_gra):"
Read(*,*) Read_number
Vig_Position = Vig(Read_number)
Vipg_Position = Vipg(Vig_Position)
n_iter = 0
Result_of_calculation = Vig_Position
Do while( Vipg_Position .ne. Vipg(1) )
n_iter = n_iter + 1
Vig_Position = Vipg_Position
Result_of_calculation = Result_of_calculation + Vig_Position
Vipg_Position = Vipg(Vig_Position)
! Do we need to make vals bigger?
if (n_iter > size(vals)) call resize(vals)
vals(n_iter) = vals_t(Vig_Position,Vipg_Position,Result_of_calculation)
End Do
Write(*,'(a,1x,i0)')"The number of iteration is:",n_iter
Write(*,'(a,1x,i0)')"The result of calculation is:",Result_of_calculation
! Now vals is an array of size(vals) of the sets of values
! For demonstration, print the size of the array and the values
Write(*,'(a,1x,i0)')"Size of vals is:", size(vals)
Write(*,'(3i7)') vals(1:n_iter)
contains
! Subroutine resize reallocates the array passed to it
! with double the current size, copies the old data to
! the new array, and transfers the allocation to the
! input array
subroutine resize(old_array)
type(vals_t), allocatable, intent(inout) :: old_array(:)
type(vals_t), allocatable :: new_array(:)
! Allocate a new array at double the size
allocate (new_array(2*size(old_array)))
write (*,*) "Allocated new array of size ", size(new_array)
! Copy the data
new_array(1:size(old_array)) = old_array
! Transfer the allocation to old_array
call MOVE_ALLOC (FROM=new_array, TO=old_array)
! new_array is now deallocated
return
end subroutine resize
End Program Arrays_0
Sample output:
Enter the number (From 1 to Br_gra):
12
Allocated new array of size 4
The number of iteration is: 3
The result of calculation is: 23
Size of vals is: 4
7 3 19
3 1 22
1 0 23
This question already has answers here:
integer, do loop, fortran, error
(1 answer)
Why are the elements of an array formatted as zeros when they are multiplied by 1/2 or 1/3?
(1 answer)
Closed 5 years ago.
I am doing a for loop to calculate the present value. When j = 1, I will get the correct product and sum, but when j goes to 2 till 20, the product will be just 0. may I know what did I miss out?
program q5
implicit none
integer :: j, k, lx, d, ld, row, col
real :: pv, v, qd, sum, product
real, dimension(110,3) :: arr
sum = 0.0
product = 0.0
lx = 0
ld = 0
qd = 0.0
!connect file
open( unit = 1, file = 'Females_Australian_Life_Tables_2010-12.csv' )
do row = 1, 110
read( 1, *) arr(row,:)
write(*,*) arr(row,:)
enddo
do j = 1, 20
d = 66 + j - 1
v = 1 / ( 1 + 0.05 )
lx = arr(66,2)
ld = arr(d,2)
qd = arr(d,3)
product = ( ld/lx ) * qd * (v**j)
sum = sum + product
print*, '*************', lx, ld, qd, '**********'
print*, 'j=', j
print*, ' product ', product
print*, ' sum ', sum
enddo
pv = 30000 * sum
!disconnect file
close( 1 )
print*, 'The present value is', pv
end program q5
this is the error I have got
Closed. This question does not meet Stack Overflow guidelines. It is not currently accepting answers.
We don’t allow questions seeking recommendations for books, tools, software libraries, and more. You can edit the question so it can be answered with facts and citations.
Closed 6 years ago.
Improve this question
In MatLab, the command lu(A) gives as output the two matrices L and U, that is, the LU factorization of A. I was wondering whether there is some command in Fortran doing exactly the same. I have not been able to find it anywhere. I found a lot of subroutines of LAPACK which solve linear systems by first performing the LU factorization, but for my purpouses I need to specifically perform the LU factorization and store the L and U matrices.
Is there a command or subroutine which has as input a square matrix A and as outputs the matrices L and U of the LU factorization?
There is no built-in command that corresponds to lu in Matlab, but we can write a simple wrapper to dgetrf in LAPACK such that the interface is similar to lu, e.g.,
module linalg
implicit none
integer, parameter :: dp = kind(0.0d0)
contains
subroutine lufact( A, L, U, P )
!... P * A = L * U
!... http://www.netlib.org/lapack/explore-3.1.1-html/dgetrf.f.html
!... (note that the definition of P is opposite to that of the above page)
real(dp), intent(in) :: A(:,:)
real(dp), allocatable, dimension(:,:) :: L, U, P
integer, allocatable :: ipiv(:)
real(dp), allocatable :: row(:)
integer :: i, n, info
n = size( A, 1 )
allocate( L( n, n ), U( n, n ), P( n, n ), ipiv( n ), row( n ) )
L = A
call DGETRF( n, n, L, n, ipiv, info )
if ( info /= 0 ) stop "lufact: info /= 0"
U = 0.0d0
P = 0.0d0
do i = 1, n
U( i, i:n ) = L( i, i:n )
L( i, i:n ) = 0.0d0
L( i, i ) = 1.0d0
P( i, i ) = 1.0d0
enddo
!... Assuming that P = P[ipiv(n),n] * ... * P[ipiv(1),1]
!... where P[i,j] is a permutation matrix for i- and j-th rows.
do i = 1, n
row = P( i, : )
P( i, : ) = P( ipiv(i), : )
P( ipiv(i), : ) = row
enddo
endsubroutine
end module
Then, we can test the routine with a 3x3 matrix shown in the Matlab page for lu():
program test_lu
use linalg
implicit none
real(dp), allocatable, dimension(:,:) :: A, L, U, P
allocate( A( 3, 3 ) )
A( 1, : ) = [ 1, 2, 3 ]
A( 2, : ) = [ 4, 5, 6 ]
A( 3, : ) = [ 7, 8, 0 ]
call lufact( A, L, U, P ) !<--> [L,U,P] = lu( A ) in Matlab
call show( "A =", A )
call show( "L =", L )
call show( "U =", U )
call show( "P =", P )
call show( "P * A =", matmul( P, A ) )
call show( "L * U =", matmul( L, U ) )
call show( "P' * L * U =", matmul( transpose(P), matmul( L, U ) ) )
contains
subroutine show( msg, X )
character(*) :: msg
real(dp) :: X(:,:)
integer i
print "(/,a)", trim( msg )
do i = 1, size(X,1)
print "(*(f8.4))", X( i, : )
enddo
endsubroutine
end program
which gives the expected result:
A =
1.0000 2.0000 3.0000
4.0000 5.0000 6.0000
7.0000 8.0000 0.0000
L =
1.0000 0.0000 0.0000
0.1429 1.0000 0.0000
0.5714 0.5000 1.0000
U =
7.0000 8.0000 0.0000
0.0000 0.8571 3.0000
0.0000 0.0000 4.5000
P =
0.0000 0.0000 1.0000
1.0000 0.0000 0.0000
0.0000 1.0000 0.0000
P * A =
7.0000 8.0000 0.0000
1.0000 2.0000 3.0000
4.0000 5.0000 6.0000
L * U =
7.0000 8.0000 0.0000
1.0000 2.0000 3.0000
4.0000 5.0000 6.0000
P' * L * U =
1.0000 2.0000 3.0000
4.0000 5.0000 6.0000
7.0000 8.0000 0.0000
Here please note that the inverse of P is given by its transpose (i.e., inv(P) = P' = transpose(P)) because P is the product of (elementary) permutation matrices.
I have added an method to compute LU using DOLITTLE method. Which is used by MATLAB to computed LU for faster computation involving larger matrices. The algorithm is as follows. To execute the algorithm you have to provide an input file in the format given below. Since the algorithm is a subroutine, you can add it to your code and call it whenever required. Algorithm, input file, output file are as follows.
PROGRAM DOLITTLE
IMPLICIT NONE
INTEGER :: n
!**********************************************************
! READS THE NUMBER OF EQUATIONS TO BE SOLVED.
OPEN(UNIT=1,FILE='input.dat',ACTION='READ',STATUS='OLD')
READ(1,*) n
CLOSE(1)
!**********************************************************
CALL LU(n)
END PROGRAM
!==========================================================
! SUBROUTINES TO MAIN PROGRAM
SUBROUTINE LU(n)
IMPLICIT NONE
INTEGER :: i,j,k,p,n,z,ii,itr = 500000
REAL(KIND=8) :: temporary,s1,s2
REAL(KIND=8),DIMENSION(1:n) :: x,b,y
REAL(KIND=8),DIMENSION(1:n,1:n) :: A,U,L,TEMP
REAL(KIND=8),DIMENSION(1:n,1:n+1) :: AB
! READING THE SYSTEM OF EQUATIONS
OPEN(UNIT=2,FILE='input.dat',ACTION='READ',STATUS='OLD')
READ(2,*)
DO I=1,N
READ(2,*) A(I,:)
END DO
DO I=1,N
READ(2,*) B(I)
END DO
CLOSE(2)
DO z=1,itr
U(:,:) = 0
L(:,:) = 0
DO j = 1,n
L(j,j) = 1.0d0
END DO
DO j = 1,n
U(1,j) = A(1,j)
END DO
DO i=2,n
DO j=1,n
DO k=1,i1
s1=0
if (k==1)then
s1=0
else
DO p=1,k1
s1=s1+L(i,p)*U(p,k)
end DO
endif
L(i,k)=(A(i,k)-s1)/U(k,k)
END DO
DO k=i,n
s2=0
DO p=1,i-1
s2=s2+l(i,p)*u(p,k)
END DO
U(i,k)=A(i,k)*s2
END DO
END DO
END DO
IF(z.eq.1)THEN
OPEN(UNIT=3,FILE='output.dat',ACTION='write')
WRITE(3,*) ''
WRITE(3,*) '********** SOLUTIONS *********************'
WRITE(3,*) ''
WRITE(3,*) ''
WRITE(3,*) 'UPPER TRIANGULAR MATRIX'
DO I=1,N
WRITE(3,*) U(I,:)
END DO
WRITE(3,*) ''
WRITE(3,*) ''
WRITE(3,*) 'LOWER TRIANGULAR MATRIX'
DO I=1,N
WRITE(3,*) L(I,:)
END DO
END SUBROUTINE
Here goes the input file format for system Ax=B. First line is number of equations, next three lines are the A matrix element, next three lines are B vector ,
3
10 8 3
3 20 1
4 5 15
18
23
9
And the output is generated as,
********** SOLUTIONS *********************
UPPER TRIANGULAR MATRIX
10.000000000000000 8.0000000000000000 3.0000000000000000
0.0000000000000000 17.600000000000001 0.1000000000000009
0.0000000000000000 0.0000000000000000 13.789772727272727
LOWER TRIANGULAR MATRIX
1.0000000000000000 0.0000000000000000 0.0000000000000000
0.2999999999999999 1.0000000000000000 0.0000000000000000
0.4000000000000002 0.1022727272727273 1.0000000000000000
You can try "numerical recipes in fortran 77",
there was LU decomposition subroutine.
There are a lot of useful subroutines, linalg, stasistics, etc.