From 392d782a024bf2f91ab3148bbdbfb5d76927a5db Mon Sep 17 00:00:00 2001
From: Andreas Marek <amarek@rzg.mpg.de>
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