Commit 6dd9225e authored by Andreas Marek's avatar Andreas Marek
Browse files

Remove assumed size arrays from auxilary functions

parent 103207ba
...@@ -254,10 +254,11 @@ module elpa1_auxiliary ...@@ -254,10 +254,11 @@ module elpa1_auxiliary
implicit none implicit none
integer(kind=ik) :: na, lda, nblk, matrixCols, mpi_comm_rows, mpi_comm_cols integer(kind=ik) :: na, lda, nblk, matrixCols, mpi_comm_rows, mpi_comm_cols
#ifdef DESPERATELY_WANT_ASSUMED_SIZE
real(kind=rk) :: a(lda,*)
#else
real(kind=rk) :: a(lda,matrixCols) real(kind=rk) :: a(lda,matrixCols)
! was #endif
! real a(lda, *)
integer(kind=ik) :: my_prow, my_pcol, np_rows, np_cols, mpierr integer(kind=ik) :: my_prow, my_pcol, np_rows, np_cols, mpierr
integer(kind=ik) :: l_cols, l_rows, l_col1, l_row1, l_colx, l_rowx integer(kind=ik) :: l_cols, l_rows, l_col1, l_row1, l_colx, l_rowx
integer(kind=ik) :: n, nc, i, info integer(kind=ik) :: n, nc, i, info
...@@ -976,16 +977,19 @@ module elpa1_auxiliary ...@@ -976,16 +977,19 @@ module elpa1_auxiliary
!> \param ncb Number of columns of B and C !> \param ncb Number of columns of B and C
!> \param a matrix a !> \param a matrix a
!> \param lda leading dimension of matrix a !> \param lda leading dimension of matrix a
!> \param ldaCols columns of matrix a
!> \param b matrix b !> \param b matrix b
!> \param ldb leading dimension of matrix b !> \param ldb leading dimension of matrix b
!> \param ldbCols columns of matrix b
!> \param nblk blocksize of cyclic distribution, must be the same in both directions! !> \param nblk blocksize of cyclic distribution, must be the same in both directions!
!> \param mpi_comm_rows MPI communicator for rows !> \param mpi_comm_rows MPI communicator for rows
!> \param mpi_comm_cols MPI communicator for columns !> \param mpi_comm_cols MPI communicator for columns
!> \param c matrix c !> \param c matrix c
!> \param ldc leading dimension of matrix c !> \param ldc leading dimension of matrix c
!> \param ldcCols columns of matrix c
!> \result success logical reports success or failure !> \result success logical reports success or failure
function elpa_mult_at_b_real(uplo_a, uplo_c, na, ncb, a, lda, b, ldb, nblk, mpi_comm_rows, mpi_comm_cols, c, ldc) & function elpa_mult_at_b_real(uplo_a, uplo_c, na, ncb, a, lda, ldaCols, b, ldb, ldbCols, nblk, mpi_comm_rows, &
result(success) mpi_comm_cols, c, ldc, ldcCols) result(success)
#ifdef HAVE_DETAILED_TIMINGS #ifdef HAVE_DETAILED_TIMINGS
use timings use timings
...@@ -999,8 +1003,12 @@ module elpa1_auxiliary ...@@ -999,8 +1003,12 @@ module elpa1_auxiliary
character*1 :: uplo_a, uplo_c character*1 :: uplo_a, uplo_c
integer(kind=ik) :: na, ncb, lda, ldb, nblk, mpi_comm_rows, mpi_comm_cols, ldc integer(kind=ik) :: na, ncb, lda, ldb, nblk, mpi_comm_rows, mpi_comm_cols, ldc
real(kind=rk) :: a(lda,*), b(ldb,*), c(ldc,*) ! remove assumed size! integer(kind=ik) :: ldaCols, ldbCols, ldcCols
#ifdef DESPERATELY_WANT_ASSUMED_SIZE
real(kind=rk) :: a(lda,*), b(ldb,*), c(ldc,*)
#else
real(kind=rk) :: a(lda,ldaCols), b(ldb,ldbCols), c(ldc,ldcCols)
#endif
integer(kind=ik) :: my_prow, my_pcol, np_rows, np_cols, mpierr integer(kind=ik) :: my_prow, my_pcol, np_rows, np_cols, mpierr
integer(kind=ik) :: l_cols, l_rows, l_rows_np integer(kind=ik) :: l_cols, l_rows, l_rows_np
integer(kind=ik) :: np, n, nb, nblk_mult, lrs, lre, lcs, lce integer(kind=ik) :: np, n, nb, nblk_mult, lrs, lre, lcs, lce
...@@ -1234,16 +1242,19 @@ module elpa1_auxiliary ...@@ -1234,16 +1242,19 @@ module elpa1_auxiliary
!> \param ncb Number of columns of B and C !> \param ncb Number of columns of B and C
!> \param a matrix a !> \param a matrix a
!> \param lda leading dimension of matrix a !> \param lda leading dimension of matrix a
!> \param ldaCols columns of matrix a
!> \param b matrix b !> \param b matrix b
!> \param ldb leading dimension of matrix b !> \param ldb leading dimension of matrix b
!> \param ldbCols columns of matrix b
!> \param nblk blocksize of cyclic distribution, must be the same in both directions! !> \param nblk blocksize of cyclic distribution, must be the same in both directions!
!> \param mpi_comm_rows MPI communicator for rows !> \param mpi_comm_rows MPI communicator for rows
!> \param mpi_comm_cols MPI communicator for columns !> \param mpi_comm_cols MPI communicator for columns
!> \param c matrix c !> \param c matrix c
!> \param ldc leading dimension of matrix c !> \param ldc leading dimension of matrix c
!> \param ldcCols columns of matrix c
!> \result success logical reports success or failure !> \result success logical reports success or failure
function elpa_mult_ah_b_complex(uplo_a, uplo_c, na, ncb, a, lda, b, ldb, nblk, mpi_comm_rows, mpi_comm_cols, c, ldc) & function elpa_mult_ah_b_complex(uplo_a, uplo_c, na, ncb, a, lda, ldaCols, b, ldb, ldbCols, nblk, mpi_comm_rows, &
result(success) mpi_comm_cols, c, ldc, ldcCols) result(success)
#ifdef HAVE_DETAILED_TIMINGS #ifdef HAVE_DETAILED_TIMINGS
use timings use timings
#endif #endif
...@@ -1256,7 +1267,12 @@ module elpa1_auxiliary ...@@ -1256,7 +1267,12 @@ module elpa1_auxiliary
character*1 :: uplo_a, uplo_c character*1 :: uplo_a, uplo_c
integer(kind=ik) :: na, ncb, lda, ldb, nblk, mpi_comm_rows, mpi_comm_cols, ldc integer(kind=ik) :: na, ncb, lda, ldb, nblk, mpi_comm_rows, mpi_comm_cols, ldc
complex(kind=ck) :: a(lda,*), b(ldb,*), c(ldc,*) ! remove assumed size! integer(kind=ik) :: ldaCols, ldbCols, ldcCols
#ifdef DESPERATELY_WANT_ASSUMED_SIZE
complex(kind=ck) :: a(lda,*), b(ldb,*), c(ldc,*)
#else
complex(kind=ck) :: a(lda,ldaCols), b(ldb,ldbCols), c(ldc,ldcCols)
#endif
integer(kind=ik) :: my_prow, my_pcol, np_rows, np_cols, mpierr integer(kind=ik) :: my_prow, my_pcol, np_rows, np_cols, mpierr
integer(kind=ik) :: l_cols, l_rows, l_rows_np integer(kind=ik) :: l_cols, l_rows, l_rows_np
......
...@@ -380,31 +380,41 @@ ...@@ -380,31 +380,41 @@
!c> \param ncb Number of columns of B and C !c> \param ncb Number of columns of B and C
!c> \param a matrix a !c> \param a matrix a
!c> \param lda leading dimension of matrix a !c> \param lda leading dimension of matrix a
!c> \param ldaCols columns of matrix a
!c> \param b matrix b !c> \param b matrix b
!c> \param ldb leading dimension of matrix b !c> \param ldb leading dimension of matrix b
!c> \param ldbCols columns of matrix b
!c> \param nblk blocksize of cyclic distribution, must be the same in both directions! !c> \param nblk blocksize of cyclic distribution, must be the same in both directions!
!c> \param mpi_comm_rows MPI communicator for rows !c> \param mpi_comm_rows MPI communicator for rows
!c> \param mpi_comm_cols MPI communicator for columns !c> \param mpi_comm_cols MPI communicator for columns
!c> \param c matrix c !c> \param c matrix c
!c> \param ldc leading dimension of matrix c !c> \param ldc leading dimension of matrix c
!c> \param ldcCols columns of matrix c
!c> \result success int report success (1) or failure (0) !c> \result success int report success (1) or failure (0)
!c> */ !c> */
!c> int elpa_mult_at_b_real(char uplo_a, char uplo_c, int na, int ncb, double *a, int lda, double *b, int ldb, int nlbk, int mpi_comm_rows, int mpi_comm_cols, double *c, int ldc); !c> int elpa_mult_at_b_real(char uplo_a, char uplo_c, int na, int ncb, double *a, int lda, int ldaCols, double *b, int ldb, int ldbCols, int nlbk, int mpi_comm_rows, int mpi_comm_cols, double *c, int ldc, int ldcCols);
function elpa_mult_at_b_real_wrapper(uplo_a, uplo_c, na, ncb, a, lda, b, ldb, nblk, mpi_comm_rows, mpi_comm_cols, c, ldc) & function elpa_mult_at_b_real_wrapper(uplo_a, uplo_c, na, ncb, a, lda, ldaCols, b, ldb, ldbCols, &
bind(C,name="elpa_mult_at_b_real") result(success) nblk, mpi_comm_rows, mpi_comm_cols, c, ldc, ldcCols) &
bind(C,name="elpa_mult_at_b_real") result(success)
use, intrinsic :: iso_c_binding use, intrinsic :: iso_c_binding
use elpa1_auxiliary, only : elpa_mult_at_b_real use elpa1_auxiliary, only : elpa_mult_at_b_real
implicit none implicit none
character(1,C_CHAR), value :: uplo_a, uplo_c character(1,C_CHAR), value :: uplo_a, uplo_c
integer(kind=c_int), value :: na, ncb, lda, ldb, nblk, mpi_comm_rows, mpi_comm_cols, ldc integer(kind=c_int), value :: na, ncb, lda, ldb, nblk, mpi_comm_rows, mpi_comm_cols, ldc, &
ldaCols, ldbCols, ldcCols
integer(kind=c_int) :: success integer(kind=c_int) :: success
#ifdef DESPERATELY_WANT_ASSUMED_SIZE
real(kind=c_double) :: a(lda,*), b(ldb,*), c(ldc,*) real(kind=c_double) :: a(lda,*), b(ldb,*), c(ldc,*)
#else
real(kind=c_double) :: a(lda,ldaCols), b(ldb,ldbCols), c(ldc,ldcCols)
#endif
logical :: successFortran logical :: successFortran
successFortran = elpa_mult_at_b_real(uplo_a, uplo_c, na, ncb, a, lda, b, ldb, nblk, mpi_comm_rows, mpi_comm_cols, c, ldc) successFortran = elpa_mult_at_b_real(uplo_a, uplo_c, na, ncb, a, lda, ldaCols, b, ldb, ldbCols, nblk, &
mpi_comm_rows, mpi_comm_cols, c, ldc, ldcCols)
if (successFortran) then if (successFortran) then
success = 1 success = 1
...@@ -438,31 +448,40 @@ ...@@ -438,31 +448,40 @@
!c> \param ncb Number of columns of B and C !c> \param ncb Number of columns of B and C
!c> \param a matrix a !c> \param a matrix a
!c> \param lda leading dimension of matrix a !c> \param lda leading dimension of matrix a
!c> \param ldaCols columns of matrix a
!c> \param b matrix b !c> \param b matrix b
!c> \param ldb leading dimension of matrix b !c> \param ldb leading dimension of matrix b
!c> \param ldbCols columns of matrix b
!c> \param nblk blocksize of cyclic distribution, must be the same in both directions! !c> \param nblk blocksize of cyclic distribution, must be the same in both directions!
!c> \param mpi_comm_rows MPI communicator for rows !c> \param mpi_comm_rows MPI communicator for rows
!c> \param mpi_comm_cols MPI communicator for columns !c> \param mpi_comm_cols MPI communicator for columns
!c> \param c matrix c !c> \param c matrix c
!c> \param ldc leading dimension of matrix c !c> \param ldc leading dimension of matrix c
!c> \param ldcCols columns of matrix c
!c> \result success int reports success (1) or failure (0) !c> \result success int reports success (1) or failure (0)
!c> */ !c> */
!c> int elpa_mult_ah_b_complex(char uplo_a, char uplo_c, int na, int ncb, double complex *a, int lda, double complex *b, int ldb, int nblk, int mpi_comm_rows, int mpi_comm_cols, double complex *c, int ldc); !c> int elpa_mult_ah_b_complex(char uplo_a, char uplo_c, int na, int ncb, double complex *a, int lda, double complex *b, int ldb, int nblk, int mpi_comm_rows, int mpi_comm_cols, double complex *c, int ldc);
function elpa_mult_ah_b_complex_wrapper( uplo_a, uplo_c, na, ncb, a, lda, b, ldb, nblk, mpi_comm_rows, mpi_comm_cols, c, ldc) & function elpa_mult_ah_b_complex_wrapper( uplo_a, uplo_c, na, ncb, a, lda, ldaCols, b, ldb, ldbCols, nblk, &
result(success) bind(C,name="elpa_mult_ah_b_complex") mpi_comm_rows, mpi_comm_cols, c, ldc, ldcCols) &
result(success) bind(C,name="elpa_mult_ah_b_complex")
use, intrinsic :: iso_c_binding use, intrinsic :: iso_c_binding
use elpa1_auxiliary, only : elpa_mult_ah_b_complex use elpa1_auxiliary, only : elpa_mult_ah_b_complex
implicit none implicit none
character(1,C_CHAR), value :: uplo_a, uplo_c character(1,C_CHAR), value :: uplo_a, uplo_c
integer(kind=c_int), value :: na, ncb, lda, ldb, nblk, mpi_comm_rows, mpi_comm_cols, ldc integer(kind=c_int), value :: na, ncb, lda, ldb, nblk, mpi_comm_rows, mpi_comm_cols, ldc, ldaCols, ldbCols, ldcCols
integer(kind=c_int) :: success integer(kind=c_int) :: success
#ifdef DESPERATELY_WANT_ASSUMED_SIZE
complex(kind=c_double_complex) :: a(lda,*), b(ldb,*), c(ldc,*) complex(kind=c_double_complex) :: a(lda,*), b(ldb,*), c(ldc,*)
#else
complex(kind=c_double_complex) :: a(lda,ldaCols), b(ldb,ldbCols), c(ldc,ldcCols)
#endif
logical :: successFortran logical :: successFortran
successFortran = elpa_mult_ah_b_complex(uplo_a, uplo_c, na, ncb, a, lda, b, ldb, nblk, mpi_comm_rows, mpi_comm_cols, c, ldc) successFortran = elpa_mult_ah_b_complex(uplo_a, uplo_c, na, ncb, a, lda, ldaCols, b, ldb, ldbCols, nblk, &
mpi_comm_rows, mpi_comm_cols, c, ldc, ldcCols)
if (successFortran) then if (successFortran) then
success = 1 success = 1
...@@ -500,8 +519,11 @@ ...@@ -500,8 +519,11 @@
integer(kind=c_int), value :: na, lda, nblk, matrixCols, mpi_comm_rows, mpi_comm_cols integer(kind=c_int), value :: na, lda, nblk, matrixCols, mpi_comm_rows, mpi_comm_cols
integer(kind=c_int), value :: wantDebug integer(kind=c_int), value :: wantDebug
integer(kind=c_int) :: success integer(kind=c_int) :: success
#ifdef DESPERATELY_WANT_ASSUMED_SIZE
real(kind=c_double) :: a(lda,*)
#else
real(kind=c_double) :: a(lda,matrixCols) real(kind=c_double) :: a(lda,matrixCols)
#endif
logical :: wantDebugFortran, successFortran logical :: wantDebugFortran, successFortran
if (wantDebug .ne. 0) then if (wantDebug .ne. 0) then
...@@ -549,8 +571,11 @@ ...@@ -549,8 +571,11 @@
integer(kind=c_int), value :: na, lda, nblk, matrixCols, mpi_comm_rows, mpi_comm_cols integer(kind=c_int), value :: na, lda, nblk, matrixCols, mpi_comm_rows, mpi_comm_cols
integer(kind=c_int), value :: wantDebug integer(kind=c_int), value :: wantDebug
integer(kind=c_int) :: success integer(kind=c_int) :: success
#ifdef DESPERATELY_WANT_ASSUMED_SIZE
complex(kind=c_double_complex) :: a(lda, *)
#else
complex(kind=c_double_complex) :: a(lda, matrixCols) complex(kind=c_double_complex) :: a(lda, matrixCols)
#endif
logical :: successFortran, wantDebugFortran logical :: successFortran, wantDebugFortran
...@@ -580,7 +605,7 @@ ...@@ -580,7 +605,7 @@
!c> On return, the upper triangle contains the Cholesky factor !c> On return, the upper triangle contains the Cholesky factor
!c> and the lower triangle is set to 0. !c> and the lower triangle is set to 0.
!c> \param lda Leading dimension of a !c> \param lda Leading dimension of a
!c> \param matrixCols local columns of matrix a !c> \param matrixCols local columns of matrix a
!c> \param nblk blocksize of cyclic distribution, must be the same in both directions! !c> \param nblk blocksize of cyclic distribution, must be the same in both directions!
!c> \param mpi_comm_rows MPI communicator for rows !c> \param mpi_comm_rows MPI communicator for rows
!c> \param mpi_comm_cols MPI communicator for columns !c> \param mpi_comm_cols MPI communicator for columns
...@@ -599,8 +624,11 @@ ...@@ -599,8 +624,11 @@
integer(kind=c_int), value :: na, lda, nblk, matrixCols, mpi_comm_rows, mpi_comm_cols, wantDebug integer(kind=c_int), value :: na, lda, nblk, matrixCols, mpi_comm_rows, mpi_comm_cols, wantDebug
integer(kind=c_int) :: success integer(kind=c_int) :: success
#ifdef DESPERATELY_WANT_ASSUMED_SIZE
real(kind=c_double) :: a(lda,*)
#else
real(kind=c_double) :: a(lda,matrixCols) real(kind=c_double) :: a(lda,matrixCols)
#endif
logical :: successFortran, wantDebugFortran logical :: successFortran, wantDebugFortran
if (wantDebug .ne. 0) then if (wantDebug .ne. 0) then
...@@ -647,9 +675,11 @@ ...@@ -647,9 +675,11 @@
integer(kind=c_int), value :: na, lda, nblk, matrixCols, mpi_comm_rows, mpi_comm_cols, wantDebug integer(kind=c_int), value :: na, lda, nblk, matrixCols, mpi_comm_rows, mpi_comm_cols, wantDebug
integer(kind=c_int) :: success integer(kind=c_int) :: success
#ifdef DESPERATELY_WANT_ASSUMED_SIZE
complex(kind=c_double_complex) :: a(lda,*)
#else
complex(kind=c_double_complex) :: a(lda,matrixCols) complex(kind=c_double_complex) :: a(lda,matrixCols)
#endif
logical :: wantDebugFortran, successFortran logical :: wantDebugFortran, successFortran
if (wantDebug .ne. 0) then if (wantDebug .ne. 0) then
......
...@@ -227,8 +227,8 @@ program test_transpose_multiply ...@@ -227,8 +227,8 @@ program test_transpose_multiply
call mpi_barrier(mpi_comm_world, mpierr) ! for correct timings only call mpi_barrier(mpi_comm_world, mpierr) ! for correct timings only
#endif #endif
success = elpa_mult_ah_b_complex("F","F", na, na, a, na_rows, b, na_rows, nblk, & success = elpa_mult_ah_b_complex("F","F", na, na, a, na_rows, na_cols, b, na_rows, na_cols, nblk, &
mpi_comm_rows, mpi_comm_cols, c, na_rows) mpi_comm_rows, mpi_comm_cols, c, na_rows, na_cols)
if (.not.(success)) then if (.not.(success)) then
write(error_unit,*) " elpa_mult_at_b_complex produced an error! Aborting..." write(error_unit,*) " elpa_mult_at_b_complex produced an error! Aborting..."
......
...@@ -227,8 +227,8 @@ program test_transpose_multiply ...@@ -227,8 +227,8 @@ program test_transpose_multiply
call mpi_barrier(mpi_comm_world, mpierr) ! for correct timings only call mpi_barrier(mpi_comm_world, mpierr) ! for correct timings only
#endif #endif
success = elpa_mult_at_b_real("F","F", na, na, a, na_rows, b, na_rows, nblk, & success = elpa_mult_at_b_real("F","F", na, na, a, na_rows, na_cols, b, na_rows, na_cols, nblk, &
mpi_comm_rows, mpi_comm_cols, c, na_rows) mpi_comm_rows, mpi_comm_cols, c, na_rows, na_cols)
if (.not.(success)) then if (.not.(success)) then
write(error_unit,*) "elpa_mult_at_b_real produced an error! Aborting..." write(error_unit,*) "elpa_mult_at_b_real produced an error! Aborting..."
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment