Commit 392d782a authored by Andreas Marek's avatar Andreas Marek

Remove assumed size array in call to qr decomposition

parent c8f57d2c
......@@ -143,7 +143,7 @@ module ELPA2_compute
real(kind=rk) :: a(lda,matrixCols), tmat(nbw,nbw,numBlocks)
#endif
integer(kind=ik) :: my_prow, my_pcol, np_rows, np_cols, mpierr
integer(kind=ik) :: l_cols, l_rows
integer(kind=ik) :: l_cols, l_rows, vmrCols
integer(kind=ik) :: i, j, lcs, lce, lrs, lre, lc, lr, cur_pcol, n_cols, nrow
integer(kind=ik) :: istep, ncol, lch, lcx, nlc, mynlc
integer(kind=ik) :: tile_size, l_rows_tile, l_cols_tile
......@@ -202,8 +202,18 @@ module ELPA2_compute
l_rows = local_index(na, my_prow, np_rows, nblk, -1)
allocate(vmr(max(l_rows,1),na))
call qr_pdgeqrf_2dcomm(a, lda, vmr, max(l_rows,1), tauvector(1), tmat(1,1,1), nbw, dwork_size(1), -1, na, &
nbw, nblk, nblk, na, na, 1, 0, PQRPARAM(1:11), mpi_comm_rows, mpi_comm_cols, blockheuristic)
vmrCols = na
#ifdef DESPERATELY_WANT_ASSUMED_SIZE_QR
call qr_pdgeqrf_2dcomm(a, lda, matrixCols, vmr, max(l_rows,1), vmrCols, tauvector(1), na, tmat(1,1,1), &
nbw, nbw, dwork_size, 1, -1, na, nbw, nblk, nblk, na, na, 1, 0, PQRPARAM(1:11), &
mpi_comm_rows, mpi_comm_cols, blockheuristic)
#else
call qr_pdgeqrf_2dcomm(a(1:lda,1:matrixCols), matrixCols, lda, vmr(1:max(l_rows,1),1:vmrCols), max(l_rows,1), &
vmrCols, tauvector(1:na), na, tmat(1:nbw,1:nbw,1), nbw, &
nbw, dwork_size(1:1), 1, -1, na, nbw, nblk, nblk, na, na, 1, 0, PQRPARAM(1:11), &
mpi_comm_rows, mpi_comm_cols, blockheuristic)
#endif
work_size = dwork_size(1)
allocate(work_blocked(work_size))
......@@ -235,12 +245,25 @@ module ELPA2_compute
if (useQR) then
if (which_qr_decomposition == 1) then
call qr_pdgeqrf_2dcomm(a, lda, vmr, max(l_rows,1), tauvector(1), &
tmat(1,1,istep), nbw, work_blocked, &
vmrCols = 2*n_cols
#ifdef DESPERATELY_WANT_ASSUMED_SIZE_QR
call qr_pdgeqrf_2dcomm(a, lda, matrixCols, vmr, max(l_rows,1), vmrCols, tauvector(1), &
na, tmat(1,1,istep), nbw, nbw, work_blocked, work_size, &
work_size, na, n_cols, nblk, nblk, &
istep*nbw+n_cols-nbw, istep*nbw+n_cols, 1,&
0, PQRPARAM(1:11), mpi_comm_rows, mpi_comm_cols,&
blockheuristic)
#else
call qr_pdgeqrf_2dcomm(a(1:lda,1:matrixCols), lda, matrixCols, vmr(1:max(l_rows,1),1:vmrCols) , &
max(l_rows,1), vmrCols, tauvector(1:na), na, &
tmat(1:nbw,1:nbw,istep), nbw, nbw, work_blocked(1:work_size), work_size, &
work_size, na, n_cols, nblk, nblk, &
istep*nbw+n_cols-nbw, istep*nbw+n_cols, 1,&
0, PQRPARAM(1:11), mpi_comm_rows, mpi_comm_cols,&
blockheuristic)
#endif
endif
else
......
......@@ -61,8 +61,9 @@ module elpa_pdgeqrf
contains
subroutine qr_pdgeqrf_2dcomm(a,lda,v,ldv,tau,t,ldt,work,lwork,m,n,mb,nb,rowidx,colidx,rev,trans,PQRPARAM, &
mpicomm_rows,mpicomm_cols,blockheuristic)
subroutine qr_pdgeqrf_2dcomm(a, lda, matrixCols, v, ldv, vmrCols, tau, lengthTau, t, ldt, colsT, &
work, workLength, lwork, m, n, mb, nb, rowidx, colidx, &
rev, trans, PQRPARAM, mpicomm_rows, mpicomm_cols, blockheuristic)
use precision
use ELPA1
use qr_utils_mod
......@@ -75,15 +76,18 @@ module elpa_pdgeqrf
INTEGER(kind=ik), parameter :: gmode_ = 1, rank_ = 2, eps_ = 3
! input variables (local)
integer(kind=ik) :: lda,lwork,ldv,ldt
real(kind=rk) :: a(lda,*),v(ldv,*),tau(*),work(*),t(ldt,*)
integer(kind=ik), intent(in) :: lda, lwork, ldv, ldt, matrixCols, m, vmrCols, lengthTau, &
colsT, workLength
! input variables (global)
integer(kind=ik) :: m,n,mb,nb,rowidx,colidx,rev,trans,mpicomm_cols,mpicomm_rows
integer(kind=ik) :: n, mb, nb, rowidx, colidx, rev, trans, mpicomm_cols, mpicomm_rows
#ifdef DESPERATELY_WANT_ASSUMED_SIZE_QR
integer(kind=ik) :: PQRPARAM(*)
real(kind=rk) :: a(lda,*), v(ldv,*), tau(*), t(ldt,*), work(*)
#else
integer(kind=ik) :: PQRPARAM(1:11)
real(kind=rk) :: a(1:lda,1:matrixCols), v(1:ldv,1:vmrCols), tau(1:lengthTau), &
t(1:ldt,1:colsT), work(1:workLength)
#endif
! output variables (global)
real(kind=rk) :: blockheuristic(*)
......
Markdown is supported
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