Implementing Laplace expansion in Fortran - arrays

I have to write a program that solves linear equations with the Cramer method, and ask specifically to find the determinant with the Laplace expansion.
det A = sum on i=1...N:(-1)**(i+1) a_i1 det ||A||_i1
where ||A||_i1 is the cofactor matrix of A, a n-1 X n-1 matrix, created by eliminating the i row and 1 column.
and that's where I'm stuck.
This is what I wrote so far
integer, parameter :: rk= selected_real_kind(6)
end module prec
module lap
use prec
implicit none
contains
recursive function det(a,n) result (d)
real(kind=rk), intent(in), dimension(n,n) :: a
real(kind=rk), dimension(n-1,n-1) :: b
real(kind=rk) :: d
integer ::i
integer, intent(in)::n
if (size(a) > 4) then
do i=1,n
b(1:(i-1),:) = a(1:(i-1),:)
b(i:n,:) = a((i+1):n,:)
b(:,:) = a(:,2:n)
d= ((-1)**(i+1))*a(i,1)*det(b,n)
end do
else
d = a(1,1)*a(2,2)-a(1,2)*a(2,1)
end if
end function det
end module lap
program sistema
it keeps telling me that I have non-conformant arrays, even though I'm using the subsets (and my professor says it's quite easy to obtain |A| with subsets).

It would be nice to see the portions of your code that are missing. However, I think I see the problem:
With dimensions a(n,n) and b(n-1,n-1), you cannot do b(1:(i-1),:) = a(1:(i-1),:) because the sizes of second dimension do not match. You should check the definition of a cofactor matrix - you should be removing a column as well as a row. Instead of the the three lines setting b, you should try:
b(1:(i-1),:) = a(1:(i-1),2:n)
b(i:n,:) = a((i+1):n,2:n)
Edit: damn, I always mix up row and column. Perhaps I mean remove a row instead of a column?

Related

Efficient way to do tensor product and reshape of two arrays with Fortran

I want to do the tensor product of two arrays A and B, of size L x M, and reshape the result AB so that its size is L^2 x M^2.
To me, the easiest way to do it is with this code
abj=0
do aj=1,M
do bj=1,M
abj=abj+1
abi=0
do ai=1,L
do bi=1,L
abi=abi+1
AB(abi,abj)=A(ai,aj)*B(bi,bj)
end do
end do
end do
end do
Is there a more efficient way to accomplish the same task?
EDIT
Two clarifications
Using BLAS/LAPACK is totally fine
Typically, L and M are of the order of hundreds
I'd be inclined to first create an L*L*M*M array, and then to reshape that, something like
integer, parameter :: l = 10
integer, parameter :: m = 20
integer :: a(l,m)
integer :: b(l,m)
integer :: ab(l*l,m*m)
integer :: intermediate(l,l,m,m)
integer :: i,j
do i=1,m
do j=1,l
intermediate(:,j,:,i) = a*b(j,i)
enddo
enddo
ab = reshape(intermediate, [l*l, m*m])
This should run a little faster than the naive quadruple loop, as the matrix*scalar multiplication can be optimised (or indeed performed using BLAS/LAPACK if desired).
The representation in memory of ab and intermediate is identical, so you might want to use associate to avoid the reshape and copy, e.g.
integer, parameter :: l = 10
integer, parameter :: m = 20
integer :: a(l,m)
integer :: b(l,m)
integer :: ab(l*l,m*m)
integer :: i,j,x,y
do i=1,m
x = m*(i-1)
do j=1,l
y = l*(j-1)
associate(temp => ab(y+1:y+l, x+1:x+m))
temp = a*b(j,i)
end associate
enddo
enddo

Finite difference derivative of an array

I am trying to take a derivative of an array but am having trouble. The array is two dimensional, x and y directions. I would like to take a derivative along x and along y using central difference discretization. The array has random values of numbers, no values are NaN. I will provide a basic portion of the code below to illustrate my point (assume the array u is defined and has some initial values already inputted into it)
integer :: i,j
integer, parameter :: nx=10, ny=10
real, dimension(-nx:nx, -ny:ny) :: u,v,w
real, parameter :: h
do i=-nx,nx
do j=-ny,ny
v = (u(i+1,j)-u(i-1,j))/(2*h)
w = (u(i,j+1)-u(i,j-1))/(2*h)
end do
end do
Note, assume the array u is defined and filled up before I find v,w. v,w are supposed to be derivatives of the array u along x and along y,respectively. Is this the correct way to take a derivative of an array?
I can see several problems in your code.
1.You must be careful what you have on the left hand side.
v = (u(i+1,j)-u(i-1,j))/(2*h)
means that the whole array v will be set to the same number everywhere. You don't want this in a loop. In a loop you want to set just one point at a time
v(i,j) = (u(i+1,j)-u(i-1,j)) / (2*h)
and 2) You are accessing the array out of bounds. You can keep the simple loop, but you must use the boundary points as "ghost points" which store the boundary values. If I assume that points -nx,nx,-nyandny` are lying on the boundary, then you can only compute the derivative using the central difference inside the domain:
do i=-nx+1,nx-1
do j=-ny+1,ny-1
v(i,j) = (u(i+1,j)-u(i-1,j)) / (2*h)
w(i,j) = (u(i,j+1)-u(i,j-1)) / (2*h)
end do
end do
If you need the derivative on the boundary, you must use a on-sided difference like
do j=-ny+1,ny-1
v(nx,j) = (u(nx,j)-u(nx-1,j)) / h
w(nx,j) = (u(nx,j+1)-u(nx,j-1)) / h
end do

Access element of N-D array using a vector [duplicate]

This question already has an answer here:
Using a vector to index a multidimensional Fortran array
(1 answer)
Closed 4 years ago.
Is there a way I can access the nth element of an array a, where n is a 1D array and size(n) is the rank of a.
Edit 2015-08-22 15:21
I am thinking of something similar to
program Example1D
integer :: a(6), b(1)
a = reshape( (/ (i , i = 1, size(a) ) /) , shape(a) )
b = (/ 5 /)
write(*,*) a(b)
end program Example1D
So I can call like this
program Want2D
integer :: a(6,5), b(2)
a = reshape( (/ (i , i = 1, size(a) ) /) , shape(a) )
b = (/ 5 , 3 /)
write(*,*) a(b)
end program Want2D
You are attempting to use a vector-subscript (e.g. Fortran 2008, cl. 6.5.3.3.2). This allows you to use a vector (1D array) to select random elements from an array dimension. This, however, cannot be used exactly as you intend it to select an element from multiple dimensions.
From 6.5.3.3 (emphasis mine):
In an array-section having a section-subscript-list, each subscript-triplet and vector-subscript in the section sub-
script list indicates a sequence of subscripts, which may be empty. Each subscript in such a sequence shall be
within the bounds for its dimension unless the sequence is empty. The array section is the set of elements from
the array determined by all possible subscript lists obtainable from the single subscripts or sequences of subscripts
specified by each section subscript.
If you goal in your example code is to select the element a(5,3) with your vector b = [5, 3], then you could change your write from
write (*,*) a(b) ! doesn't work
to:
write (*,*) a(b(1),b(2)) ! does work
You can do more complicated array-sections with b of higher ranks as long as you use a 1D section for each dimension of a. For example if a is a 5x5 array, you could get the corners with of a as a 2x2 array with:
integer :: b(2,2) ! 2 dimensional
b(1,:) = [1,5]
b(2,:) = [1,5]
write (*,*) a(b(1,:),b(2,:)) ! prints a(1,1), a(5,1), a(1,5), a(5,5)
In the comments below you requested that this be abstracted to an n-dimensional array a. Below is a function I consider ugly due to its need to use c interop in a way I consider a hack. You'll also need a newer compiler to even use the code, as it depends on assumed-rank arrays. Here is a module containing a subroutine that takes a 2-dimensional b containing array indices to print and an n-dimensional a to get the values from.
module future
implicit none
contains
subroutine print_array_vector(a, b)
use, intrinsic :: iso_c_binding, only: c_loc, c_f_pointer
implicit none
integer, dimension(..), target :: a
integer, dimension(:,:) :: b
integer :: a_rank, b_len1
integer, dimension(:,:,:), pointer :: a3
integer, dimension(:,:), pointer :: a2
integer, dimension(:), pointer :: a1
a_rank = rank(a)
if (a_rank /= size(b,1)) then
print *, "Rank mismatch between array and vector"
return
end if
if (a_rank == 3) then
call c_f_pointer(c_loc(a), a3, shape=[size(a,1), size(a,2), size(a,3)])
print *, a3(b(1,:),b(2,:),b(3,:))
else if (a_rank == 2) then
call c_f_pointer(c_loc(a), a2, shape=[size(a,1), size(a,2)])
print *, a2(b(1,:),b(2,:))
else if (a_rank == 1) then
call c_f_pointer(c_loc(a), a1, shape=[size(a,1)])
print *, a1(b(1,:))
else
print *, "Unsupported rank"
return
end if
end subroutine print_array_vector
end module future
This takes in assumed-rank a, which is not directly usable in Fortran except to pass as an actual argument to a C interface. However, we can use other parts of c-interop to get the C pointer to a, then turn it into a Fortran pointer of the appropriate shape. Now we have a in a usable form, but we have to do this within if/else blocks properly reference the different cases. I've only implemented up to 3-dimensional a, the rest is left as an exercise to the reader.
To use this function, here is an example:
program test
use future
implicit none
integer :: a3(5,5,5), a2(5,5), a1(5)
integer :: b3(3,2), b2(2,2), b1(1,2)
integer :: i
a3 = reshape([(i,i=1,125)],shape(a3))
a2 = reshape([(i,i=1,25)],shape(a2))
a1 = [(i,i=1,5)]
b3 = reshape([1,1,1,5,5,5],shape(b3))
b2 = reshape([1,1,5,5],shape(b2))
b1 = reshape([1,5],shape(b1))
call print_array_vector(a1,b1)
call print_array_vector(a2,b2)
call print_array_vector(a3,b3)
end program test
This constructs a 3-dim a, a 2-dim a, and a 1-dim a, and a few 2-dim b's with the locations of the corners of the arrays and then we call the function to print the locations of the vector from the array.
% ./arraysection
1 5
1 5 21 25
1 5 21 25 101 105 121 125
I compiled and tested this with gfortran 5.2 and I have no idea the current state of support for assumed-rank arrays in other version of gfortran or in other Fortran compilers.

How to fill bidimensional arrays in fortran90

i have an issue about filling a bidimensional array in Fortran90. in my program I extract different sets of random numbers and check them as uncertainties to my measurements ustar and Tstar, and i get uerr and terr. Now I want to put uerr and terr in a two-dimensional array because then I have to repeat this procedure n times to get different dataset (the Monte Carlo method for the estimation of errors). How do I assign uerr and terr to my array? And how do I iterate the process n times each time you run the program? I tried giving my array "set" the indexes r and c but at compile I get:
Warning: Extension: REAL array index at (1)
i read ustar and tstar from an input file, the code is below:
program stimerr
implicit none
character(len=12) filein,fileout
integer,dimension(1) :: seed = (/4/)
real, dimension(2) :: num
integer :: n,h,i
real, dimension(24,2) :: set
real :: pi = 3.14159
real :: g1,g2,ustar,tstar,uerr,terr
write(*,'(2x,''File di input .......''/)')
read(*,'(a12)') filein
open(unit=120,File=filein)
set = 0.
call init_random_seed ()
do n=1,24
read(120,*) h,ustar,tstar
call random_number(num)
g1 =(sqrt(-2*log(num(1)))*(cos(2*pi*(num(2)))))/10.
g2 =(sqrt(-2*log(num(1)))*(sin(2*pi*(num(2)))))/10.
uerr = ustar + g1
terr = tstar + g2
write(*,*) set(uerr,terr)
enddo
close(120)
end program stimerr

Parsing a complicated function using MKL/VML

I am trying to calculate a fairly complicated function, say func() - involving several additions, substractions, multiplications, divisions and trigonometric functions, of several two-dimensional arrays in fortran. The calculation is massively parrallel, in that each func() is independent over its row and column location. Each of the matrices is many gigabytes in size, and there are about a dozen of them as arguments.
I would like to make use of Intel MKL functions (invoking --mkl-parallel), in particular VML functions to add, subtract, divide etc. My question is: how can I render a complicated functional expression such as,
e.g.: func(x,y,z) = x*y+cos(z*x-x) where x,y,z are 2d arrays of several GB
in terms of VML functions but using more familiar binary operators. You see my problem requires, in principle, converting all the binary operators, such as "+" and "*" into binary functions taking arguments as ?vadd(x,y). Of course this would be very cumbersome and unsightly for large expressions. Is there a way to overload the binary arithmetic operators such as "+","-" to preferentially use MKL/VML versions in fortran. An example would be nice! Thanks!
I know this answer is a little bit off-topic.
Since all the operations are element-wise and your operations are simple, the func() could be a memory bandwidth bounded task. In this case, using VML may not be a good choice to maximum the performance.
Suppose each of your arrays is of 10GB in size, uisng VML as follows will need at least 9 x 10GB reading and 5 x 10GB writing.
func(...) {
tmp1=x*z
tmp1=tmp1-x;
tmp1=cos(tmp1);
tmp2=x*y;
return tmp1+tmp2;
}
where all the operations all overloaded for 2d array.
Instead you may find the following approach has much less memory access (3 x 10GB reading and 1 x 10GB writing) thus could be quicker (pseudo code).
$omp parallel for
for i in 1 to m
for j in 1 to n
result(i,j)= x(i,j)*y(i,j)+cos(z(i,j)*x(i,j)-x(i,j));
end
end
I developped a small example to show the addition of two vectors. As I don't have MKL installed anymore, I used the SAXPY command from BLAS. The principle should be the same.
At first you define a module with the appropriate definitions. In my case this would be an assignment to save a real array in my datatype (this is only a convenience function as you could also directly access the array variable) and the definition of the addition. Both are a new overload to the + operator and = assignment.
In the program, I define three fields. Two of them get assigned with random numbers and then added to get the third field. Then the first two fields get stored in my special variables, and the result of this addition is stored in a third variable of this type.
Finally, the result is compared by accessing the array directly. Please note, that the assignment from custom datatype to the same datatype is already defined (e.g. ffield3 = ffield1 is already defined.)
My module:
MODULE fasttype
IMPLICIT NONE
PRIVATE
PUBLIC :: OPERATOR(+), ASSIGNMENT(=)
TYPE,PUBLIC :: fastreal
REAL,DIMENSION(:),ALLOCATABLE :: array
END TYPE
INTERFACE OPERATOR(+)
MODULE PROCEDURE fast_add
END INTERFACE
INTERFACE ASSIGNMENT(=)
MODULE PROCEDURE fast_assign
END INTERFACE
CONTAINS
FUNCTION fast_add(fr1, fr2) RESULT(fr3)
TYPE(FASTREAL), INTENT(IN) :: fr1, fr2
TYPE(FASTREAL) :: fr3
INTEGER :: L
L = SIZE(fr2%array)
fr3 = fr2
CALL SAXPY(L, 1., fr1%array, 1, fr3%array, 1)
END FUNCTION
SUBROUTINE fast_assign(fr1, r2)
TYPE(FASTREAL), INTENT(OUT) :: fr1
REAL, DIMENSION(:), INTENT(IN) :: r2
INTEGER :: L
IF (.NOT. ALLOCATED(fr1%array)) THEN
L = SIZE(r2)
ALLOCATE(fr1%array(L))
END IF
fr1%array = r2
END SUBROUTINE
END MODULE
My program:
PROGRAM main
USE fasttype
IMPLICIT NONE
REAL, DIMENSION(:), ALLOCATABLE :: field1, field2, field3
TYPE(fastreal) :: ffield1, ffield2, ffield3
ALLOCATE(field1(10),field2(10),field3(10))
CALL RANDOM_NUMBER(field1)
CALL RANDOM_NUMBER(field2)
field3 = field1 + field2
ffield1 = field1
ffield2 = field2
ffield3 = ffield1 + ffield2
WRITE(*,*) field3 == ffield3%array
END PROGRAM

Resources