Related
Before someone closes the question, yes, there are many questions that seem similar, but so far I haven't found one with this exact weird problem that seems to go away only sometimes.
I had an odd Fortran error while trying to make a module for linear regression.
The module is named "LSQregression" and the main program "LSQAdvertising". Compiling it using the following gfortran command works:
gfortran ../LSQregression.f90 LinearAdvertising.f90 -llapack -o LinAd
However, I'd like to be able to turn my module into a .o file and link it with whatever program I may need instead of compiling again every time. So I tried to do that:
gfortran -c ../LSQregression.f90
And then link it with my program file like that:
gfortran ../LSQregression.o LinearAdvertising.f90 -llapack -o LinAd
I also tried also turning the program into a .o file. Neither works, they both return the following error:
/usr/bin/ld: /tmp/ccf7T1aj.o: in function `MAIN__':
LinearAdvertising.f90:(.text+0x1f8b): undefined reference to `__lsqregression_MOD_lsqestimate_simple'
collect2: error: ld returned 1 exit status
It refers to the following function in the module that is being called here inside the program:
print *, LSQestimate(test,LSQbeta(inputs,sales,(/1,2/)) )
The function itself is defined as part of an interface:
interface LSQestimate
procedure LSQestimate_simple, LSQestimate_using
end interface LSQestimate
real(8) function LSQestimate_simple(X, beta)
implicit none
real(8), dimension(:,:) :: X, beta
real(8) :: boundary, Y
integer :: i, Xlen, betalen
Xlen = size(X, 1)
betalen = size(beta, 1)
if (Xlen + 1 .ne. betalen) stop "incompatible beta and X"
Y = beta(1,1)
do i = 1, Xlen
Y = Y + beta(i+1, 1)*X(i,1)
end do
LSQestimate_simple = Y
end function LSQestimate_simple
It's very odd because I've done the same thing with another function and it seems to work fine, and the problem only happens when I turn the module into a .o file first, and goes away if I try to directly compile the .f90 file... I can't figure out why one works and the other doesn't.
EDIT: Someone told me to do nm ../LSQregression.o | grep -i regression . I have no idea what that does but I did it so here are the results if it helps at all:
0000000000002768 T __lsqregression_MOD_inv
0000000000000b85 T __lsqregression_MOD_lsqbeta_simple
000000000000035c T __lsqregression_MOD_lsqbeta_using
0000000000000000 T __lsqregression_MOD_lsqdecision
Oddly enough the name of the function in question doesn't even appear here.
EDIT 2: Decided to post the entire code of the module:
module LSQregression
implicit none
public :: LSQbeta, LSQestimate
interface LSQbeta
procedure LSQbeta_simple, LSQbeta_using
end interface LSQbeta
interface LSQestimate
procedure LSQestimate_simple, LSQestimate_using
end interface LSQestimate
contains
function inv(A) result(Ainv)
implicit none
real(8), dimension(:,:), intent(in) :: A
real(8), dimension(size(A,1),size(A,2)) :: Ainv
real(8), dimension(size(A,1)) :: work ! work array for LAPACK
integer, dimension(size(A,1)) :: ipiv ! pivot indices
integer :: n, info
! External procedures defined in LAPACK
external DGETRF
external DGETRI
! Store A in Ainv to prevent it from being overwritten by LAPACK
Ainv = A
n = size(A,1)
! DGETRF computes an LU factorization of a general M-by-N matrix A
! using partial pivoting with row interchanges.
call DGETRF(n, n, Ainv, n, ipiv, info)
if (info /= 0) then
stop 'Matrix is numerically singular!'
end if
! DGETRI computes the inverse of a matrix using the LU factorization
! computed by DGETRF.
call DGETRI(n, Ainv, n, ipiv, work, n, info)
if (info /= 0) then
stop 'Matrix inversion failed!'
end if
end function inv
!----------------------------------------------------------------------
function LSQbeta_simple(Xold, Y) result(beta)
real(8), dimension(:,:) :: Xold, Y
real(8), dimension(size(Xold,1), size(Xold,2)+1) :: X
real(8), dimension(:,:), allocatable :: beta, XTX, IXTX, pinv
integer :: rowsX, colsX, rowsY, colsY,i
rowsX = size(X(:,1))
colsX = size(X(1,:))
rowsY = size(Y(:,1))
colsY = size(Y(1,:))
if (colsY .ne. 1) stop 'Inappropriate y'
if (rowsY .ne. rowsX) stop "Y and X rows don't match"
!---X-ify-----------
X(:,1) = 1.0 !includes 1 in the first column
do i = 2, colsX
X(:,i) = Xold(:,i-1)
end do
!--------------------
allocate(XTX(colsX,colsX))
allocate(IXTX(colsX,colsX))
allocate(pinv(colsX,rowsY))
allocate(beta(colsX,1))
XTX = matmul(transpose(X),X)
IXTX = inv(XTX)
pinv = matmul(IXTX, transpose(X))
beta = matmul(pinv, Y)
deallocate(pinv)
deallocate(XTX)
deallocate(IXTX)
return
deallocate(beta)
end function LSQbeta_simple
!--------------------------------------------
function LSQbeta_using(Xold, Y, indexes) result(beta)
implicit none
real(8), dimension(:,:) :: Xold, Y
integer, dimension(:) :: indexes
real(8), dimension(size(indexes)+1,1) :: beta
real(8), dimension(size(Xold,1),size(indexes)) :: X
integer :: indLen,i
indLen = size(indexes)
do i = 1, indLen
X(:,i) = Xold(:,indexes(i))
end do
beta = LSQbeta_simple(X,Y)
end function LSQbeta_using
real(8) function LSQestimate_simple(X, beta)
implicit none
real(8), dimension(:,:) :: X, beta
real(8) :: boundary, Y
integer :: i, Xlen, betalen
Xlen = size(X, 1)
betalen = size(beta, 1)
if (Xlen + 1 .ne. betalen) stop "incompatible beta and X"
Y = beta(1,1)
do i = 1, Xlen
Y = Y + beta(i+1, 1)*X(i,1)
end do
LSQestimate_simple = Y
end function LSQestimate_simple
real(8) function LSQestimate_using()
LSQestimate_using = 1.0D0
end function LSQestimate_using
logical function LSQdecision(X, beta, boundary)
implicit none
real(8), dimension(:,:) :: X, beta
real(8) :: boundary
LSQdecision = LSQestimate(X, beta) > boundary
end function LSQdecision
end module LSQregression
I'm seeing a strange issue. Sample code is included below
When this code is run with valgrind, it complains that the memory allocated with popen is still reachable. Should i worry about this warning? If yes, what is a possible solution?
Func1()
FILE *fp = NULL;
int fd = 0;
fp = popen(g_cmd, "r");
fd = fileno(fp); // store fd for later processing.
...
Func2(fd)
FILE *popen_fp = NULL;
popen_fp = fdopen(fd, "r"); // Convert fd to File pointer.
if (popen_fp) pclose(popen_fp);
==11748== 256 bytes in 1 blocks are still reachable in loss record 1 of 1
==11748== at 0x4C29F73: malloc
==11748== by 0x5542627: popen##GLIBC_2.2.5
LEAK SUMMARY:
==11748== definitely lost: 0 bytes in 0 blocks
==11748== indirectly lost: 0 bytes in 0 blocks
==11748== possibly lost: 0 bytes in 0 blocks
==11748== still reachable: 256 bytes in 1 blocks
I am confused about the performance of Fortran writing and reading performance (speed) versus MPI one for small and big files.
I wrote the following simple dummy program to test this (just writing dummy values to files):
PROGRAM test
!
IMPLICIT NONE
!
#if defined (__MPI)
!
! Include file for MPI
!
#if defined (__MPI_MODULE)
USE mpi
#else
INCLUDE 'mpif.h'
#endif
#else
! dummy world and null communicator
INTEGER, PARAMETER :: MPI_COMM_WORLD = 0
INTEGER, PARAMETER :: MPI_COMM_NULL = -1
INTEGER, PARAMETER :: MPI_COMM_SELF = -2
#endif
INTEGER (kind=MPI_OFFSET_KIND) :: lsize, pos, pos2
INTEGER, PARAMETER :: DP = 8
REAL(kind=DP), ALLOCATABLE, DIMENSION(:) :: trans_prob, array_cpu
INTEGER :: ierr, i, error, my_pool_id, world_comm
INTEGER (kind=DP) :: fil
REAL :: start, finish
INTEGER :: iunepmat, npool, arr_size, loop, pos3, j
real(dp):: dummy
integer*8 :: unf_recl
integer :: ios, direct_io_factor, recl
iunepmat = 10000
arr_size = 102400
loop = 500
! Initialize MPI
CALL MPI_INIT(ierr)
call MPI_COMM_DUP(MPI_COMM_WORLD, world_comm, ierr)
call MPI_COMM_RANK(world_comm,my_pool_id,error)
ALLOCATE(trans_prob(arr_size))
trans_prob(:) = 1.5d0
!Write using Fortran
CALL MPI_BARRIER(world_comm,error)
!
CALL cpu_time(start)
!
DO i=1, loop
! This writes also info on the record length using a real with 4 bytes.
OPEN(unit=10+my_pool_id, form='unformatted', position='append', action='write')
WRITE(10+my_pool_id ) trans_prob(:)
CLOSE(unit=10+my_pool_id)
ENDDO
CALL MPI_COMM_SIZE(world_comm, npool, error)
! Master collect and write
IF (my_pool_id==0) THEN
INQUIRE (IOLENGTH=direct_io_factor) dummy
unf_recl = direct_io_factor * int(arr_size * loop, kind=kind(unf_recl))
ALLOCATE (array_cpu( arr_size * loop ))
array_cpu(:) = 0.0d0
OPEN(unit=100,file='merged.dat',form='unformatted', status='new', position='append', action='write')
DO i=0, npool - 1
OPEN(unit=10+i,form='unformatted', status ='old', access='direct', recl = unf_recl )
READ(unit=10+i, rec=1) array_cpu(:)
CLOSE(unit=10+i)
WRITE(unit=100) array_cpu(:)
ENDDO
CLOSE(unit=100)
DEALLOCATE (array_cpu)
ENDIF
call cpu_time(finish)
!Print time
CALL MPI_BARRIER(world_comm,error)
IF (my_pool_id==0) print*, ' Fortran time', finish-start
!Write using MPI
CALL MPI_BARRIER(world_comm,error)
!
CALL cpu_time(start)
!
lsize = INT( arr_size , kind = MPI_OFFSET_KIND)
pos = 0
pos2 = 0
CALL MPI_FILE_OPEN(world_comm, 'MPI.dat',MPI_MODE_WRONLY + MPI_MODE_CREATE,MPI_INFO_NULL,iunepmat,ierr)
DO i=1, loop
pos = pos2 + INT( arr_size * (my_pool_id), kind = MPI_OFFSET_KIND ) * 8_MPI_OFFSET_KIND
CALL MPI_FILE_SEEK(iunepmat, pos, MPI_SEEK_SET, ierr)
CALL MPI_FILE_WRITE(iunepmat, trans_prob, lsize, MPI_DOUBLE_PRECISION,MPI_STATUS_IGNORE,ierr)
pos2 = pos2 + INT( arr_size * (npool -1), kind = MPI_OFFSET_KIND ) * 8_MPI_OFFSET_KIND
ENDDO
!
CALL MPI_FILE_CLOSE(iunepmat,ierr)
CALL cpu_time(finish)
CALL MPI_BARRIER(world_comm,error)
IF (my_pool_id==0) print*, ' MPI time', finish-start
DEALLOCATE (trans_prob)
END PROGRAM
The compilation is made with:
mpif90 -O3 -x f95-cpp-input -D__FFTW -D__MPI -D__SCALAPACK test_mpi2.f90 -o a.x
and then run in parallel with 4 cores:
mpirun -np 4 ./a.x
I get the following results:
Loop size 1
array size 10,240,000
File size: 313 Mb
Fortran time 0.237030014 sec
MPI time 0.164155006 sec
Loop size 10
array size 1,024,000
File size: 313 Mb
Fortran time 0.242821991 sec
MPI time 0.172048002 sec
Loop size 100
array size 102,400
File size: 313 Mb
Fortran time 0.235879987 sec
MPI time 9.78289992E-02 sec
Loop size 50
array size 1,024,000
File size: 1.6G
Fortran time 1.60272002 sec
MPI time 3.40623116 sec
Loop size 500
array size 102,400
File size: 1.6G
Fortran time 1.44547606 sec
MPI time 3.38340592 sec
As you can see the performances of MPI degrade significantly for larger files. Is it possible to improve MPI performance for large files ?
Is this behavior expected?
I'm using Fortran I'm trying to create matrices where their elements are functions. Also I'd like to operate with them and the result still be a function. So here is what I try
module Greeninverse
use, intrinsic :: iso_fortran_env, only: dp => real64
implicit none
real(dp), public, parameter :: wl = 1d0
real(dp), public, parameter :: wr = 1d0
integer, public, parameter :: matrix_size = 5
type ptr_wrapper
procedure(f), nopass, pointer :: func
end type ptr_wrapper
abstract interface
function f(x1,x2)
import
real(dp), intent(in) :: x1
real(dp), intent(in) :: x2
complex (dp), dimension(matrix_size,matrix_size):: f
end function f
end interface
contains
function Sigma(x1) result(S)
real(dp),intent(in) :: x1
complex(dp), dimension(matrix_size,matrix_size) :: S
real(dp):: aux_wr1,aux_wl1
complex(dp) :: S11, Snn
integer :: i,j
aux_wr1 = 1-x1**2/(2d0*wr)
aux_wl1 = 1-x1**2/(2d0*wl)
S11 = dcmplx(.5*(x1**2-2d0*wl), 2.0*wL*dsqrt(1-aux_wL1**2))
Snn = dcmplx(.5*(x1**2-2d0*wr), 2.0*wr*dsqrt(1-aux_wr1**2))
do i = 1, matrix_size
do j=i,matrix_size
S(i,j) = 0d0
S(j,i) = 0d0
end do
end do
S(1,1) = S11
S(matrix_size,matrix_size) = Snn
end function Sigma
function Omega(x1) result(Om)
real(dp),intent(in) :: x1
real(dp),dimension(matrix_size, matrix_size) :: Om
integer :: i,j
do i=1,matrix_size
do j= i, matrix_size
Om(i,j) = 0d0
Om(j,i) = 0d0
end do
end do
do i = 1,matrix_size
Om(i,i) = x1**2
end do
end function Omega
! Now I'd like to add them and take the inverse of the sum and still be a function
function Inversa(x1,x2) result (G0inv)
real(dp), intent(in) :: x1
real(dp), intent(in) :: x2
complex(dp), dimension(matrix_size,matrix_size) :: G0inv
complex(dp),dimension(matrix_size,matrix_size) :: Gaux
! Down here all these variables are needed by ZGETRF and ZGETRI
DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: WORK
Integer:: LWORK = matrix_size*matrix_size
Integer, Allocatable, dimension(:) :: IPIV
Integer :: INFO, LDA = matrix_size, M = matrix_size, N = matrix_size
Integer DeAllocateStatus
external liblapack
allocate(work(Lwork))
allocate(IPIV(N))
Gaux = Omega(x1)+Sigma(x2)
CALL ZGETRF (M, N, Gaux, LDA, IPIV, INFO)
! This calculates LU descomposition of a matrix and overwrites it
CALL ZGETRI(N, Gaux, N, IPIV, WORK, LWORK, INFO)
! This calculates the inverse of a matrix knowing its LU descomposition and overwrites it
G0inv = Gaux
end function Inversa
! Now I'd like to derive it
function Derivate(x1,x2,G) result(d)
! This function is supposed to derivate a matrix which its elements are functions but of two variables; x1 and x2. And it only derives respect the first variable
implicit none
real(dp), intent(in) :: x1
real(dp), intent(in) :: x2
procedure(f),pointer:: G
complex(dp),dimension(matrix_size,matrix_size) :: d
real(dp) :: h = 1.0E-6
d = (1.0*G(x1-2*h,x2) - 8.0*G(x1-h,x2) + 8.0*G(x1+h,x2) - 1.0*G(x1+2*h,x2))/(12.0*h)
end function Derivate
end module Greeninverse
program Greentest3
use, intrinsic :: iso_fortran_env, only: dp => real64
use Greeninverse
implicit none
real(dp) :: W(matrix_size,matrix_size)
complex(dp) :: S(matrix_size,matrix_size)
complex(dp) :: G(matrix_size,matrix_size)
complex(dp) :: DD(matrix_size,matrix_size)
W(:,:) = Omega(1d0)
S(:,:) = Sigma(2d0)
G(:,:) = Inversa(1d0,2d0)
DD(:,:) = Derivate(1d0,2d0,Inversa)
print*, W
print*, S
print*, G
print*, DD
end program Greentest3
The problem is in the function Derivate that I don't know how to say that the argument G is a matrix function and because of that I get an error message
DD(:,:) = Derivate(1d0,2d0,Inversa)
1
Error: Expected a procedure pointer for argument ‘g’ at (1)
That's why I use the abstract interface that it's supposed to say that is a function but it doesn't work as I expected
I tried also to make a pointer in the module section, that is
type(ptr_wrapper) :: DD(matrix_size,matrix_size)
but I get an error message
Error: Unexpected data declaration statement in CONTAINS section at (1)
I'd like to make all the matrices in the module section and in the program just evaluate them in the values of interest.
What am I doing wrong?
Looking at the function Derivate the dummy argument G is declared like
procedure(f), pointer:: G
This is a procedure pointer. The error message confirms that.
The actual argument to be passed to Derivate is, in this case, expected also to be a procedure pointer. Let's look at what the argument is:
DD(:,:) = Derivate(...,Inversa)
Inversa is a procedure (function), defined in the module. It, crucially, isn't a procedure pointer. So, indeed, the compiler complains.
Well, how do we go about fixing this? There are three obvious approaches:
have the actual argument a procedure pointer;
have the dummy argument a procedure (non-pointer);
allow argument association between a pointer and non-pointer.
For the first, the main program could have
procedure(f), pointer :: Inversa_ptr ! We've a procedure pointer...
Inversa_ptr => Inversa ! ... which we point at our procedure...
DD(:,:) = Derivate(...,Inversa_ptr) ! ... and is then the argument
For the Derivate as it is implemented, it doesn't use the pointer nature of the argument G: just the target is referenced. This means that the other two options become available.
We can make the dummy argument not a pointer, having
function Derivate(...,G)
procedure(f) :: G
end function
used like
DD(:,:) = Derivate(...,Inversa)
The third of our choices comes from defining the dummy argument as
function Derivate(...,G)
procedure(f), pointer, intent(in) :: G
end function
where, again, the reference is as in the second case.
When the dummy argument procedure pointer has the intent(in) attribute, it is allowed to be associated with a non-pointer procedure which is a valid target in pointer assignment. In this case G becomes pointer associated with that actual argument procedure (and because of the intent, that status can't be changed in the function).
I need to pad the output of an integer to a given length.
For example, with a length of 4 digits, the output of the integer 4 is "0004" instead of "4". How can I do this in Erlang?
adding a bit of explanation to Zed's answer:
Erlang Format specification is: ~F.P.PadModC.
"~4..0B~n" translates to:
~F. = ~4. (Field width of 4)
P. = . (no Precision specified)
Pad = 0 (Pad with zeroes)
Mod = (no control sequence Modifier specified)
C = B (Control sequence B = integer in default base 10)
and ~n is new line.
io:format("~4..0B~n", [Num]).
string:right(integer_to_list(4), 4, $0).
The problem with io:format is that if your integer doesn't fit, you get asterisks:
> io:format("~4..0B~n", [1234]).
1234
> io:format("~4..0B~n", [12345]).
****
The problem with string:right is that it throws away the characters that don't fit:
> string:right(integer_to_list(1234), 4, $0).
"1234"
> string:right(integer_to_list(12345), 4, $0).
"2345"
I haven't found a library module that behaves as I would expect (i.e. print my number even if it doesn't fit into the padding), so I wrote my own formatting function:
%%------------------------------------------------------------------------------
%% #doc Format an integer with a padding of zeroes
%% #end
%%------------------------------------------------------------------------------
-spec format_with_padding(Number :: integer(),
Padding :: integer()) -> iodata().
format_with_padding(Number, Padding) when Number < 0 ->
[$- | format_with_padding(-Number, Padding - 1)];
format_with_padding(Number, Padding) ->
NumberStr = integer_to_list(Number),
ZeroesNeeded = max(Padding - length(NumberStr), 0),
[lists:duplicate(ZeroesNeeded, $0), NumberStr].
(You can use iolist_to_binary/1 to convert the result to binary, or you can use lists:flatten(io_lib:format("~s", [Result])) to convert it to a list.)
Eshell V12.0.3 (abort with ^G)
1> F = fun(Max, I)-> case Max - length(integer_to_list(I)) of X when X > 0 -> string:chars($0, X) ++ integer_to_list(I); _ -> I end end.
#Fun<erl_eval.43.40011524>
2> F(10, 22).
"0000000022"
3> F(3, 22345).
22345