Skip to content
GitLab
Commit 5ff5b75c authored by Andreas Marek's avatar Andreas Marek
Browse files

Retab

parent 4b712509
Hide whitespace changes
Inline Side-by-side
src/elpa2/qr/elpa_pdgeqrf_template.X90
View file @ 5ff5b75c
...@@ -338,47 +338,47 @@ ...@@ -338,47 +338,47 @@
!print *,'updating trailing matrix' !print *,'updating trailing matrix'
if (updatemode .eq. ichar('I')) then if (updatemode .eq. ichar('I')) then
print *,'pdgeqrf_2dcomm: incremental update not yet implemented! rev=1' print *,'pdgeqrf_2dcomm: incremental update not yet implemented! rev=1'
else if (updatemode .eq. ichar('F')) then else if (updatemode .eq. ichar('F')) then
! full update no merging ! full update no merging
call qr_pdlarfb_1dcomm_& call qr_pdlarfb_1dcomm_&
&PRECISION & &PRECISION &
(m,mb,lcols,update_lcols,a(1,offset),lda,v(1,update_voffset),ldv, & (m,mb,lcols,update_lcols,a(1,offset),lda,v(1,update_voffset),ldv, &
work(temptau_offset+update_voffset-1), & work(temptau_offset+update_voffset-1), &
t(update_voffset,update_voffset),ldt, & t(update_voffset,update_voffset),ldt, &
rowidx,idx,1,mpicomm_rows,work(work_offset),lwork) rowidx,idx,1,mpicomm_rows,work(work_offset),lwork)
else else
! full update + merging default ! full update + merging default
call qr_tmerge_pdlarfb_1dcomm_& call qr_tmerge_pdlarfb_1dcomm_&
&PRECISION & &PRECISION &
(m,mb,lcols,n-(update_voffset+update_lcols-1),update_lcols, & (m,mb,lcols,n-(update_voffset+update_lcols-1),update_lcols, &
v(1,update_voffset),ldv, & v(1,update_voffset),ldv, &
t(update_voffset,update_voffset),ldt, & t(update_voffset,update_voffset),ldt, &
a(1,offset),lda,rowidx,1,updatemode,mpicomm_rows, & a(1,offset),lda,rowidx,1,updatemode,mpicomm_rows, &
work(work_offset),lwork) work(work_offset),lwork)
end if end if
else else
if (updatemode .eq. ichar('I')) then if (updatemode .eq. ichar('I')) then
!print *,'sole merging of (incremental) T matrix', mpirank_cols, & !print *,'sole merging of (incremental) T matrix', mpirank_cols, &
! n-(update_voffset+incremental_update_size-1) ! n-(update_voffset+incremental_update_size-1)
call qr_tmerge_pdlarfb_1dcomm_& call qr_tmerge_pdlarfb_1dcomm_&
&PRECISION & &PRECISION &
(m,mb,0,n-(update_voffset+incremental_update_size-1), & (m,mb,0,n-(update_voffset+incremental_update_size-1), &
incremental_update_size,v(1,update_voffset),ldv, & incremental_update_size,v(1,update_voffset),ldv, &
t(update_voffset,update_voffset),ldt, & t(update_voffset,update_voffset),ldt, &
a,lda,rowidx,1,updatemode,mpicomm_rows,work(work_offset),lwork) a,lda,rowidx,1,updatemode,mpicomm_rows,work(work_offset),lwork)
! reset for upcoming incremental updates ! reset for upcoming incremental updates
incremental_update_size = 0 incremental_update_size = 0
else if (updatemode .eq. ichar('M')) then else if (updatemode .eq. ichar('M')) then
! final merge ! final merge
call qr_tmerge_pdlarfb_1dcomm_& call qr_tmerge_pdlarfb_1dcomm_&
&PRECISION & &PRECISION &
(m,mb,0,n-(update_voffset+update_lcols-1),update_lcols, & (m,mb,0,n-(update_voffset+update_lcols-1),update_lcols, &
v(1,update_voffset),ldv, & v(1,update_voffset),ldv, &
t(update_voffset,update_voffset),ldt, & t(update_voffset,update_voffset),ldt, &
a,lda,rowidx,1,updatemode,mpicomm_rows,work(work_offset),lwork) a,lda,rowidx,1,updatemode,mpicomm_rows,work(work_offset),lwork)
else else
! full updatemode - nothing to update ! full updatemode - nothing to update
end if end if
...@@ -895,7 +895,7 @@ ...@@ -895,7 +895,7 @@
end if end if
call local_size_offset_1d(n,nb,idx,idx-1,rev,mpirank,mpiprocs, & call local_size_offset_1d(n,nb,idx,idx-1,rev,mpirank,mpiprocs, &
local_size,baseoffset,local_offset) local_size,baseoffset,local_offset)
local_offset = local_offset * incx local_offset = local_offset * incx
...@@ -1159,18 +1159,18 @@ ...@@ -1159,18 +1159,18 @@
! check for border cases (only a 2x2 matrix left) ! check for border cases (only a 2x2 matrix left)
if (idx .le. 1) then if (idx .le. 1) then
#ifdef DOUBLE_PRECISION_REAL #ifdef DOUBLE_PRECISION_REAL
tau(1:2) = 0.0_rk8 tau(1:2) = 0.0_rk8
t(1:2,1:2) = 0.0_rk8 t(1:2,1:2) = 0.0_rk8
#else #else
tau(1:2) = 0.0_rk4 tau(1:2) = 0.0_rk4
t(1:2,1:2) = 0.0_rk4 t(1:2,1:2) = 0.0_rk4
#endif #endif
call obj%timer%stop("qr_pdlarfg2_1dcomm_& call obj%timer%stop("qr_pdlarfg2_1dcomm_&
&PRECISION& &PRECISION&
&") &")
return return
end if end if
call qr_pdlarfg2_1dcomm_seed_& call qr_pdlarfg2_1dcomm_seed_&
...@@ -1933,8 +1933,8 @@ ...@@ -1933,8 +1933,8 @@
! collect D part ! collect D part
call local_size_offset_1d(m,mb,baseidx-k,baseidx-k,1, & call local_size_offset_1d(m,mb,baseidx-k,baseidx-k,1, &
mpirank,mpiprocs, & mpirank,mpiprocs, &
localsize,baseoffset,localoffset) localsize,baseoffset,localoffset)
!print *,'localsize',localsize,localoffset !print *,'localsize',localsize,localoffset
#ifdef DOUBLE_PRECISION_REAL #ifdef DOUBLE_PRECISION_REAL
...@@ -2021,7 +2021,7 @@ ...@@ -2021,7 +2021,7 @@
! local variables ! local variables
integer(kind=ik) :: i,j,l integer(kind=ik) :: i,j,l
real(kind=C_DATATYPE_KIND) :: sum_squares,diagonal_square,relative_error,epsd,diagonal_root real(kind=C_DATATYPE_KIND) :: sum_squares,diagonal_square,epsd,diagonal_root
real(kind=C_DATATYPE_KIND) :: dreverse_matrix_work(1) real(kind=C_DATATYPE_KIND) :: dreverse_matrix_work(1)
! external functions ! external functions
...@@ -2148,9 +2148,6 @@ ...@@ -2148,9 +2148,6 @@
sum_squares = sdot(i-1,work(1,i),1,work(1,i),1) sum_squares = sdot(i-1,work(1,i),1,work(1,i),1)
end if end if
#endif #endif
!relative_error = sum_squares / diagonal_square
!print *,'error ',i,sum_squares,diagonal_square,relative_error
if (sum_squares .ge. (epsd * diagonal_square)) then if (sum_squares .ge. (epsd * diagonal_square)) then
possiblerank = max(i-1,1) possiblerank = max(i-1,1)
call obj%timer%stop("qr_pdlarfgk_1dcomm_check_improved_& call obj%timer%stop("qr_pdlarfgk_1dcomm_check_improved_&
...@@ -2260,9 +2257,9 @@ ...@@ -2260,9 +2257,9 @@
! transpose matrix ! transpose matrix
do icol=1,k do icol=1,k
do isqr=icol+1,k do isqr=icol+1,k
work(icol,isqr) = work(isqr,icol) work(icol,isqr) = work(isqr,icol)
end do end do
end do end do
! work contains now the full inner product of the global (sub-)matrix ! work contains now the full inner product of the global (sub-)matrix
...@@ -2406,7 +2403,7 @@ ...@@ -2406,7 +2403,7 @@
call MPI_Comm_size(mpicomm, mpiprocs, mpierr) call MPI_Comm_size(mpicomm, mpiprocs, mpierr)
lidx = baseidx-sidx+1 lidx = baseidx-sidx+1
call local_size_offset_1d(n,nb,baseidx,lidx-1,rev,mpirank,mpiprocs, & call local_size_offset_1d(n,nb,baseidx,lidx-1,rev,mpirank,mpiprocs, &
local_size,baseoffset,local_offset) local_size,baseoffset,local_offset)
local_offset = local_offset * incx local_offset = local_offset * incx
......
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