I need to find a faster way to transpose a matrix using MKL. And I tried mkl_domatcopy from MKL but never get it right.
Here is the test code(Fortran):
PROGRAM MAIN
INTEGER, PARAMETER:: NROW = 3 !rows
INTEGER, PARAMETER:: NCOL = 3 !cols
REAL*8, ALLOCATABLE:: M(:,:)
REAL*8, ALLOCATABLE:: MT(:,:)
INTEGER:: i,j
ALLOCATE(M(NROW,NCOL))
ALLOCATE(MT(NROW,NCOL))
DO i = 1, NROW
DO j = 1, NCOL
M(i,j)=i
END DO
END DO
call mkl_domatcopy("c","t",3,3,9,M,3,MT,3)
print *,M
print *,"************************"
print *,MT
END
And the output is:
1.00000000000000 2.00000000000000 3.00000000000000
1.00000000000000 2.00000000000000 3.00000000000000
1.00000000000000 2.00000000000000 3.00000000000000
************************
0
why the MT is 0?Is it beacause I use it wrong or something?
Documents about this function:
https://software.intel.com/en-us/node/520863
PS:I still don't get what 'alpha' means.
As user roygvib suggests in the comments, by including the mkl.fi file would give you additional details.
This code
PROGRAM MAIN
INCLUDE 'mkl.fi'
INTEGER, PARAMETER:: NROW = 3 !rows
INTEGER, PARAMETER:: NCOL = 3 !cols
REAL*8, ALLOCATABLE:: M(:,:)
REAL*8, ALLOCATABLE:: MT(:,:)
INTEGER:: i,j
ALLOCATE(M(NROW,NCOL))
ALLOCATE(MT(NROW,NCOL))
DO i = 1, NROW
DO j = 1, NCOL
M(i,j)=i
END DO
END DO
call mkl_domatcopy("c","t",3,3,9,M,3,MT,3)
print *,M
print *,"************************"
print *,MT
END
raises the following error
test.f90(23): error #6633: The type of the actual argument differs
from the type of the dummy argument. [9]
call mkl_domatcopy("c","t",3,3,9,M,3,MT,3)
-----------------------------------------------^ compilation aborted for test.f90 (code 1)
Interestingly, if you turn that 9 into a double precision value (or variable) -- note that here I simply appended the d0 suffix to the floating point value.
PROGRAM MAIN
INCLUDE 'mkl.fi'
INTEGER, PARAMETER:: NROW = 3 !rows
INTEGER, PARAMETER:: NCOL = 3 !cols
REAL*8, ALLOCATABLE:: M(:,:)
REAL*8, ALLOCATABLE:: MT(:,:)
INTEGER:: i,j
ALLOCATE(M(NROW,NCOL))
ALLOCATE(MT(NROW,NCOL))
DO i = 1, NROW
DO j = 1, NCOL
M(i,j)=i
END DO
END DO
call mkl_domatcopy("c","t",3,3,9d0,M,3,MT,3)
print *,M
print *,"************************"
print *,MT
END
then your application returns
$ ./test
1.00000000000000 2.00000000000000 3.00000000000000
1.00000000000000 2.00000000000000 3.00000000000000
1.00000000000000 2.00000000000000 3.00000000000000
************************
9.00000000000000 9.00000000000000 9.00000000000000
18.0000000000000 18.0000000000000 18.0000000000000
27.0000000000000 27.0000000000000 27.0000000000000
Finally, with respect to what alpha means, the manual says
alpha This parameter scales the input matrix by alpha.
and notice that the output is the tranposed and each element multiplied by 9.
The fastest way to do a transpose in fortran90 is as follows
B = TRANSPOSE(A)
And the fastest way to do a MATMUL is:
C = MATMUL(A,B)
As it is inherent in the language, I am not sure where MKL/IMKL comes into play?
Related
I kindly request your help on this code where I kept on getting
an error: Rank mismatch in array reference at (1) (2/1). My objective is to go through each point in a cube(p = i+(j-1)*N + (k-1)NN) and calculate the gradient of the potential along each axis (gradphi_x, gradphi_y, gradphi_z).
PROGRAM sub_rho_phi
integer, parameter:: N=3
real, dimension(N):: gradphi_x, gradphi_y, gradphi_z
call output(gradphi_x, gradphi_y, gradphi_z)
open(unit=1,file="grad_phi.dat")
l = 0
do
l=l+1
write(1,*) gradphi_x(l),gradphi_y(l),gradphi_z(l)
if ( l == N**3) then
exit
end if
end do
END
SUBROUTINE output( gradphi_x, gradphi_y, gradphi_z )
real, parameter:: h=0.7,G=6.67,M=1.98892*(10**3)!!in(10**15) kg
integer, parameter:: N=3
real, dimension(N):: r, gradphi_x,gradphi_y,gradphi_z
integer, dimension(N**3):: x,y,z
integer:: p
real:: a
a=500/h !in kpc
do i=0, N
do j=0, N
do k=0, N
p = i+(j-1)*N + (k-1)*N*N
x(p,1)=i
y(p,2)=j
z(p,3)=k
r(p)=sqrt(x(p,1)*x(p,1)+y(p,2)*y(p,2)+z(p,3)*z(p,3))
gradphi_x(p)=(G*M)*x(p,1)/r(p)*(r(p)+a)**2
gradphi_y(p)=(G*M)*y(p,2)/r(p)*(r(p)+a)**2
gradphi_z(p)=(G*M)*z(p,3)/r(p)*(r(p)+a)**2
enddo
enddo
enddo
return
END
You have declared x, y and z as one dimensional arrays, but are using two dimensional indexing all the way through output.
I am struggling with reading a text string in. Am using gfortran 4.9.2.
Below I have written a little subroutine in which I would like to submit the write format as argument.
Ideally I'd like to be able to call it with
call printarray(mat1, "F8.3")
to print out a matrix mat1 in that format for example. The numbers of columns should be determined automatically inside the subroutine.
subroutine printarray(x, udf_temp)
implicit none
real, dimension(:,:), intent(in) :: x ! array to be printed
integer, dimension(2) :: dims ! array for shape of x
integer :: i, j
character(len=10) :: udf_temp ! user defined format, eg "F8.3, ...
character(len = :), allocatable :: udf ! trimmed udf_temp
character(len = 10) :: udf2
character(len = 10) :: txt1, txt2
integer :: ncols ! no. of columns of array
integer :: udf_temp_length
udf_temp_length = len_trim(udf_temp)
allocate(character(len=udf_temp_length) :: udf)
dims = shape(x)
ncols = dims(2)
write (txt1, '(I5)') ncols
udf2 = trim(txt1)//adjustl(udf)
txt2 = "("//trim(udf2)//")"
do i = 1, dims(1)
write (*, txt2) (x(i, j), j = 1, dims(2)) ! this is line 38
end do
end suroutine printarray
when I set len = 10:
character(len=10) :: udf_temp
I get compile error:
call printarray(mat1, "F8.3")
1
Warning: Character length of actual argument shorter than of dummy argument 'udf_temp' (4/10) at (1)
When I set len = *
character(len=*) :: udf_temp
it compiles but at runtime:
At line 38 of file where2.f95 (unit = 6, file = 'stdout')
Fortran runtime error: Unexpected element '( 8
What am I doing wrong?
Is there a neater way to do this?
Here's a summary of your question that I will try to address: You want to have a subroutine that will print a specified two-dimensional array with a specified format, such that each row is printed on a single line. For example, assume we have the real array:
real, dimension(2,8) :: x
x = reshape([1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16], shape=[2,8], order=[2,1])
! Then the array is:
! 1.000 2.000 3.000 4.000 5.000 6.000 7.000 8.000
! 9.000 10.000 11.000 12.000 13.000 14.000 15.000 16.000
We want to use the format "F8.3", which prints floating point values (reals) with a field width of 8 and 3 decimal places.
Now, you are making a couple of mistakes when creating the format within your subroutine. First, you try to use udf to create the udf2 string. This is a problem because although you have allocated the size of udf, nothing has been assigned to it (pointed out in a comment by #francescalus). Thus, you see the error message you reported: Fortran runtime error: Unexpected element '( 8.
In the following, I make a couple of simplifying changes and demonstrate a few (slightly) different techniques. As shown, I suggest the use of * to indicate that the format can be applied an unlimited number of times, until all elements of the output list have been visited. Of course, explicitly stating the number of times to apply the format (ie, "(8F8.3)" instead of "(*(F8.3))") is fine, but the latter is slightly less work.
program main
implicit none
real, dimension(2,8) :: x
character(len=:), allocatable :: udf_in
x = reshape([1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16], shape=[2,8], order=[2,1])
udf_in = "F8.3"
call printarray(x, udf_in)
contains
subroutine printarray(x, udf_in)
implicit none
real, dimension(:,:), intent(in) :: x
character(len=*), intent(in) :: udf_in
integer :: ncols ! size(x,dim=2)
character(len=10) :: ncols_str ! ncols, stringified
integer, dimension(2) :: dims ! shape of x
character(len=:), allocatable :: udf0, udf1 ! format codes
integer :: i, j ! index counters
dims = shape(x) ! or just use: ncols = size(x, dim=2)
ncols = dims(2)
write (ncols_str, '(i0)') ncols ! use 'i0' for min. size
udf0 = "(" // ncols_str // udf_in // ")" ! create string: "(8F8.3)"
udf1 = "(*(" // udf_in // "))" ! create string: "(*(F8.3))"
print *, "Version 1:"
do i = 1, dims(1)
write (*, udf0) (x(i, j), j = 1,ncols) ! implied do-loop over j.
end do
print *, "Version 2:"
do i = 1, dims(1)
! udf1: "(*(F8.3))"
write (*, udf1) (x(i, j), j = 1,ncols) ! implied do-loop over j
end do
print *, "Version 3:"
do i = 1, size(x,dim=1) ! no need to create nrows/ncols vars.
write(*, udf1) x(i,:) ! let the compiler handle the extents.
enddo
end subroutine printarray
end program main
Observe: the final do-loop ("Version 3") is very simple. It does not need an explicit count of ncols because the * takes care of it automatically. Due to its simplicity, there is really no need for a subroutine at all.
besides the actual error (not using the input argument), this whole thing can be done much more simply:
subroutine printarray(m,f)
implicit none
character(len=*)f
real m(:,:)
character*10 n
write(n,'(i0)')size(m(1,:))
write(*,'('//n//f//')')transpose(m)
end subroutine
end
note no need for the loop constructs as fortran will automatically write the whole array , line wrapping as you reach the length of data specified by your format.
alternately you can use a loop construct, then you can use a '*' repeat count in the format and obviate the need for the internal write to construct the format string.
subroutine printarray(m,f)
implicit none
character(len=*)f
real m(:,:)
integer :: i
do i=1,size(m(:,1))
write(*,'(*('//f//'))')m(i,:)
enddo
end subroutine
end
I have written a Fortran program to compute the Lagrange interpolation of two data sets: x,G. I am not able to evaluate the defined function correctly. Please see what I did wrong as while my program runs, the numbers are not at all accurate for the fxn see first two programs (Matlab code) to see actual result). They are provided by the author and are what I am trying to emulate on Fortran:
%% example 1.1 langrange interpolation %(Matlab)
% X : interpolation points
% Y : value of f(X)
% x : points where we want an evaluation of P(x),
% where P is the interpolator polynomial
x = [-1:0.01:1];
X = [-1:0.20:1];
y = 1./(1+25*x.^2);
Y = 1./(1+25*X.^2);
pol = lagrange_interp(X,Y,x)
%plot(x,pol,'k',x,y,'k--',X,Y,'k.');
legend('Lagrange Polynomial','Expected behavior','Data Points');
function polynomial = lagrange_interp(X,Y,x) %(Matlab)
n = length(X);
phi = ones(n,length(x));
polynomial = zeros(1,length(x));
i = 0;
j = 0;
for i = [1:n]
for j = [1:n]
if not(i==j)
phi(i,:) = phi(i,:).*(x-X(j))./(X(i)-X(j));
end;
end;
end;
for i = [1:n]
polynomial = polynomial + Y(i)*phi(i,:);
end;
!Lagrange Interpolation example !(Fortran)
program Lagrange
implicit none
integer:: i
integer, parameter:: n=10
integer, parameter:: z=201
integer, parameter:: z1=11
real, parameter:: delta=.01
real,parameter:: delta2=.20
real, dimension(1:z):: x,G,y,H
real*8, dimension(1:n):: M
real*8, dimension(1:n):: linterp(n)
x(1)=-1
G(1)=-1
do i=2,z
x(i)=x(i-1)+delta
y(i)=1/(1+25*(x(i)**2))
end do
print*, "The one-dimensional array x is:", x(1:z)
print*, "The one dimensional array y is", y(1:z)
do i=2,z1
G(i)=G(i-1)+delta2
H(i)=1/(1+25*(G(i)**2))
end do
print*,"The other one-dimensional array G is:", G(1:z1)
print*, "Then the one dimensional array H is", H(1:z1)
M=linterp(1:n)
print*, M(1:n)
end program
!Lagrange interpolation polynomial function !(Fortran)
real*8 function linterp(n)
implicit none
integer,parameter:: n=10
integer, dimension(1:n):: poly,pol
integer:: i, j
i=0
j=0
do i=1,n
do j=1,n
if (i/=j)then
poly(i,j)=poly(i,j)*(x(i)-G(j))/(y(i)-G(j))
end if
end do
end do
print*, poly(i,j)
do i=1,n
pol(i)=pol(i)+H(i)*poly(i,j)
end do
print*, pol(1:n)
end function
so reading the following question (Correct use of FORTRAN INTENT() for large arrays) I learned that defining a variable with intent(in) isn't enough, since when the variable is passed to another subroutine/function, it can be changed again. So how can I avoid this? In the original thread they talked about putting the subroutine into a module, but that doesn't help for me. For example I want to calculate the determinant of a matrix with a LU-factorization. Therefore I use the Lapack function zgetrf, but however this function alters my input matrix and the compiler don't displays any warnings. So what can I do?
module matHelper
implicit none
contains
subroutine initMat(AA)
real*8 :: u
double complex, dimension(:,:), intent(inout) :: AA
integer :: row, col, counter
counter = 1
do row=1,size(AA,1)
do col=1,size(AA,2)
AA(row,col)=cmplx(counter ,0)
counter=counter+1
end do
end do
end subroutine initMat
!subroutine to write a Matrix to file
!Input: AA - double complex matrix
! fid - integer file id
! fname - file name
! stat - integer status =replace[0] or old[1]
subroutine writeMat(AA,fid, fname, stat)
integer :: fid, stat
character(len=*) :: fname
double complex, dimension(:,:), intent(in) :: AA
integer :: row, col
character (len=64) :: fmtString
!opening file with given options
if(fid /= 0) then
if(stat == 0) then
open(unit=fid, file=fname, status='replace', &
action='write')
else if(stat ==1) then
open(unit=fid, file=fname, status='old', &
action='write')
else
print*, 'Error while trying to open file with Id', fid
return
end if
end if
!initializing matrix print format
write(fmtString,'(I0)') size(aa,2)
fmtString = '('// trim(fmtString) //'("{",ES10.3, ",", 1X, ES10.3,"}",:,1X))'
!write(*,*) fmtString
!writing matrix to file by iterating through each row
do row=1,size(aa,1)
write(fid,fmt = fmtString) AA(row,:)
enddo
write(fid,*) ''
end subroutine writeMat
!function to calculate the determinant of the input
!Input: AA - double complex matrix
!Output determinantMat - double complex,
! 0 if AA not a square matrix
function determinantMat(AA)
double complex, dimension(:,:), intent(in) :: AA
double complex :: determinantMat
integer, dimension(min(size(AA,1),size(AA,2)))&
:: ipiv
integer :: ii, info
!check if not square matrix, then set determinant to 0
if(size(AA,1)/= size(AA,2)) then
determinantMat = 0
return
end if
!compute LU facotirzation with LAPACK function
call zgetrf(size(AA,1),size(AA,2), AA,size(AA,1), ipiv,info)
if(info /= 0) then
determinantMat = cmplx(0.D0, 0.D0)
return
end if
determinantMat = cmplx(1.D0, 0.D0)
!determinant of triangular matrix is product of diagonal elements
do ii=1,size(AA,1)
if(ipiv(ii) /= ii) then
!a permutation was done, so a factor of -1
determinantMat = -determinantMat *AA(ii,ii)
else
!no permutation, so no -1
determinantMat = determinantMat*AA(ii,ii)
end if
end do
end function determinantMat
end module matHelper
!***********************************************************************
!module which stores matrix elements, dimension, trace, determinant
program test
use matHelper
implicit none
double complex, dimension(:,:), allocatable :: AA, BB
integer :: n, fid
fid = 0;
allocate(AA(3,3))
call initMat(AA)
call writeMat(AA,0,' ', 0)
print*, 'Determinante: ',determinantMat(AA) !changes AA
call writeMat(AA,0, ' ', 0)
end program test
PS: I am using the ifort compiler v15.0.3 20150407
I do not have ifort at home, but you may want to try compiling with '-check interfaces' and maybe with '-ipo'. You may need the path to 'zgetrf' for the '-check interfaces' to work, and if that is not source then it may not help.
If you declare 'function determinantMat' as 'PURE FUNCTION determinantMat' then I am pretty sure it would complain because 'zgetrf' is not known to be PURE nor ELEMENTAL. Try ^this stuff^ first.
If LAPACK has a module, then zgetrf could be known to be, or not be, PURE/ELEMENTAL. https://software.intel.com/en-us/articles/blas-and-lapack-fortran95-mod-files
I would suggest you add to your compile line:
-check interfaces -ipo
During initial build I like (Take it out for speed once it works):
-check all -warn all
Making a temporary array is one way around it. (I have not compiled this, so it is only a conceptual exemplar.)
PURE FUNCTION determinantMat(AA)
USE LAPACK95 !--New Line--!
IMPLICIT NONE !--New Line--!
double complex, dimension(:,:) , intent(IN ) :: AA
double complex :: determinantMat !<- output
!--internals--
integer, dimension(min(size(AA,1),size(AA,2))) :: ipiv
!!--Next line is new--
double complex, dimension(size(AA,1),size(AA,2)) :: AA_Temp !!<- I have no idea if this will work, you may need an allocatable??
integer :: ii, info
!check if not square matrix, then set determinant to 0
if(size(AA,1)/= size(AA,2)) then
determinantMat = 0
return
end if
!compute LU factorization with LAPACK function
!!--Next line is new--
AA_Temp = AA !--Initialise AA_Temp to be the same as AA--!
call zgetrf(size(AA_temp,1),size(AA_Temp,2), AA_Temp,size(AA_Temp,1), ipiv,info)
if(info /= 0) then
determinantMat = cmplx(0.D0, 0.D0)
return
end if
determinantMat = cmplx(1.D0, 0.D0)
!determinant of triangular matrix is product of diagonal elements
do ii=1,size(AA_Temp,1)
if(ipiv(ii) /= ii) then
!a permutation was done, so a factor of -1
determinantMat = -determinantMat *AA_Temp(ii,ii)
else
!no permutation, so no -1
determinantMat = determinantMat*AA_Temp(ii,ii)
end if
end do
end function determinantMat
With the 'USE LAPACK95' you probably do not need PURE, but if you wanted it to be PURE then you want to explicitly say so.
I kindly request your help on this code where I kept on getting
an error: Rank mismatch in array reference at (1) (2/1). My objective is to go through each point in a cube(p = i+(j-1)*N + (k-1)NN) and calculate the gradient of the potential along each axis (gradphi_x, gradphi_y, gradphi_z).
PROGRAM sub_rho_phi
integer, parameter:: N=3
real, dimension(N):: gradphi_x, gradphi_y, gradphi_z
call output(gradphi_x, gradphi_y, gradphi_z)
open(unit=1,file="grad_phi.dat")
l = 0
do
l=l+1
write(1,*) gradphi_x(l),gradphi_y(l),gradphi_z(l)
if ( l == N**3) then
exit
end if
end do
END
SUBROUTINE output( gradphi_x, gradphi_y, gradphi_z )
real, parameter:: h=0.7,G=6.67,M=1.98892*(10**3)!!in(10**15) kg
integer, parameter:: N=3
real, dimension(N):: r, gradphi_x,gradphi_y,gradphi_z
integer, dimension(N**3):: x,y,z
integer:: p
real:: a
a=500/h !in kpc
do i=0, N
do j=0, N
do k=0, N
p = i+(j-1)*N + (k-1)*N*N
x(p,1)=i
y(p,2)=j
z(p,3)=k
r(p)=sqrt(x(p,1)*x(p,1)+y(p,2)*y(p,2)+z(p,3)*z(p,3))
gradphi_x(p)=(G*M)*x(p,1)/r(p)*(r(p)+a)**2
gradphi_y(p)=(G*M)*y(p,2)/r(p)*(r(p)+a)**2
gradphi_z(p)=(G*M)*z(p,3)/r(p)*(r(p)+a)**2
enddo
enddo
enddo
return
END
You have declared x, y and z as one dimensional arrays, but are using two dimensional indexing all the way through output.