From 392d782a024bf2f91ab3148bbdbfb5d76927a5db Mon Sep 17 00:00:00 2001 From: Andreas Marek Date: Tue, 2 Feb 2016 07:38:06 +0100 Subject: [PATCH] Remove assumed size array in call to qr decomposition --- src/elpa2_compute.F90 | 33 ++++++++++++++++++++++++++++----- src/elpa_qr/elpa_pdgeqrf.F90 | 14 +++++++++----- 2 files changed, 37 insertions(+), 10 deletions(-) diff --git a/src/elpa2_compute.F90 b/src/elpa2_compute.F90 index 18137f56..9dde5dc8 100644 --- a/src/elpa2_compute.F90 +++ b/src/elpa2_compute.F90 @@ -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 diff --git a/src/elpa_qr/elpa_pdgeqrf.F90 b/src/elpa_qr/elpa_pdgeqrf.F90 index 41d797b3..2cc5b83b 100644 --- a/src/elpa_qr/elpa_pdgeqrf.F90 +++ b/src/elpa_qr/elpa_pdgeqrf.F90 @@ -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(*) -- GitLab