Commit 36a6642b authored by Andreas Marek's avatar Andreas Marek

Bit of cleanup of bandred

parent 1a9a7ee3
...@@ -271,24 +271,24 @@ ...@@ -271,24 +271,24 @@
successCUDA = cuda_malloc(a_dev, lda*na_cols* size_of_datatype) successCUDA = cuda_malloc(a_dev, lda*na_cols* size_of_datatype)
if (.not.(successCUDA)) then if (.not.(successCUDA)) then
print *,"bandred_& print *,"bandred_&
&MATH_DATATYPE& &MATH_DATATYPE&
&: error in cudaMalloc a_dev 1" &: error in cudaMalloc a_dev 1"
stop 1 stop 1
endif endif
successCUDA = cuda_malloc(tmat_dev, nbw*nbw* size_of_datatype) successCUDA = cuda_malloc(tmat_dev, nbw*nbw* size_of_datatype)
if (.not.(successCUDA)) then if (.not.(successCUDA)) then
print *,"bandred_& print *,"bandred_&
&MATH_DATATYPE& &MATH_DATATYPE&
&: error in cudaMalloc tmat_dev 1" &: error in cudaMalloc tmat_dev 1"
stop 1 stop 1
endif endif
successCUDA = cuda_malloc(vav_dev, nbw*nbw* size_of_datatype) successCUDA = cuda_malloc(vav_dev, nbw*nbw* size_of_datatype)
if (.not.(successCUDA)) then if (.not.(successCUDA)) then
print *,"bandred_& print *,"bandred_&
&MATH_DATATYPE& &MATH_DATATYPE&
&: error in cudaMalloc vav_dev 1" &: error in cudaMalloc vav_dev 1"
stop 1 stop 1
endif endif
endif ! useGPU endif ! useGPU
...@@ -334,15 +334,15 @@ ...@@ -334,15 +334,15 @@
#ifdef USE_ASSUMED_SIZE_QR #ifdef USE_ASSUMED_SIZE_QR
call qr_pdgeqrf_2dcomm_& call qr_pdgeqrf_2dcomm_&
&PRECISION& &PRECISION&
&(obj, a, lda, matrixCols, vmrCPU, max(l_rows,1), vmrCols, tauvector(1), na, tmat(1,1,1), & &(obj, a, lda, matrixCols, vmrCPU, 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), & nbw, nbw, dwork_size, 1, -1, na, nbw, nblk, nblk, na, na, 1, 0, PQRPARAM(1:11), &
mpi_comm_rows, mpi_comm_cols, blockheuristic) mpi_comm_rows, mpi_comm_cols, blockheuristic)
#else #else
call qr_pdgeqrf_2dcomm_& call qr_pdgeqrf_2dcomm_&
&PRECISION& &PRECISION&
&(obj, a(1:lda,1:matrixCols), matrixCols, lda, vmrCPU(1:max(l_rows,1),1:vmrCols), max(l_rows,1), & &(obj, a(1:lda,1:matrixCols), matrixCols, lda, vmrCPU(1:max(l_rows,1),1:vmrCols), max(l_rows,1), &
vmrCols, tauvector(1:na), na, tmat(1:nbw,1:nbw,1), nbw, & 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), & 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) mpi_comm_rows, mpi_comm_cols, blockheuristic)
...@@ -374,8 +374,8 @@ ...@@ -374,8 +374,8 @@
successCUDA = cuda_memcpy(a_dev, loc(a(1,1)), (lda)*(na_cols)* size_of_datatype, cudaMemcpyHostToDevice) successCUDA = cuda_memcpy(a_dev, loc(a(1,1)), (lda)*(na_cols)* size_of_datatype, cudaMemcpyHostToDevice)
if (.not.(successCUDA)) then if (.not.(successCUDA)) then
print *,"bandred_& print *,"bandred_&
&MATH_DATATYPE& &MATH_DATATYPE&
&: error in cudaMemcpy a_dev 2" &: error in cudaMemcpy a_dev 2"
stop 1 stop 1
endif endif
endif ! useGPU endif ! useGPU
...@@ -405,16 +405,16 @@ ...@@ -405,16 +405,16 @@
deallocate(vr, stat=istat, errmsg=errorMessage) deallocate(vr, stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then if (istat .ne. 0) then
print *,"bandred_& print *,"bandred_&
&MATH_DATATYPE& &MATH_DATATYPE&
&: error when deallocating vr "//errorMessage &: error when deallocating vr "//errorMessage
stop 1 stop 1
endif endif
endif endif
allocate(vr(l_rows + 1), stat=istat, errmsg=errorMessage) allocate(vr(l_rows + 1), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then if (istat .ne. 0) then
print *,"bandred_& print *,"bandred_&
&MATH_DATATYPE& &MATH_DATATYPE&
&: error when allocating vr "//errorMessage &: error when allocating vr "//errorMessage
stop 1 stop 1
endif endif
...@@ -425,15 +425,15 @@ ...@@ -425,15 +425,15 @@
deallocate(vmrCUDA, stat=istat, errmsg=errorMessage) deallocate(vmrCUDA, stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then if (istat .ne. 0) then
print *,"bandred_& print *,"bandred_&
&MATH_DATATYPE& &MATH_DATATYPE&
&: error when allocating vmrCUDA "//errorMessage &: error when allocating vmrCUDA "//errorMessage
stop 1 stop 1
endif endif
successCUDA = cuda_free(vmr_dev) successCUDA = cuda_free(vmr_dev)
if (.not.(successCUDA)) then if (.not.(successCUDA)) then
print *,"bandred_& print *,"bandred_&
&MATH_DATATYPE&: error in cuda_free vmr_dev 1" &MATH_DATATYPE&: error in cuda_free vmr_dev 1"
stop 1 stop 1
endif endif
endif endif
...@@ -446,15 +446,15 @@ ...@@ -446,15 +446,15 @@
#endif #endif
if (istat .ne. 0) then if (istat .ne. 0) then
print *,"bandred_& print *,"bandred_&
&MATH_DATATYPE& &MATH_DATATYPE&
&: error when allocating vmrCUDA "//errorMessage &: error when allocating vmrCUDA "//errorMessage
stop 1 stop 1
endif endif
successCUDA = cuda_malloc(vmr_dev, vmr_size* size_of_datatype) successCUDA = cuda_malloc(vmr_dev, vmr_size* size_of_datatype)
if (.not.(successCUDA)) then if (.not.(successCUDA)) then
print *,"bandred_& print *,"bandred_&
&MATH_DATATYPE& &MATH_DATATYPE&
&: error in cudaMalloc: vmr_dev2" &: error in cudaMalloc: vmr_dev2"
stop 1 stop 1
endif endif
...@@ -465,16 +465,16 @@ ...@@ -465,16 +465,16 @@
deallocate(umcCUDA, stat=istat, errmsg=errorMessage) deallocate(umcCUDA, stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then if (istat .ne. 0) then
print *,"bandred_& print *,"bandred_&
&MATH_DATATYPE& &MATH_DATATYPE&
&: error when deallocating umcCUDA "//errorMessage &: error when deallocating umcCUDA "//errorMessage
stop 1 stop 1
endif endif
successCUDA = cuda_free(umc_dev) successCUDA = cuda_free(umc_dev)
if (.not.(successCUDA)) then if (.not.(successCUDA)) then
print *,"bandred_& print *,"bandred_&
&MATH_DATATYPE& &MATH_DATATYPE&
&: error in cudaFree umc_dev 1" &: error in cudaFree umc_dev 1"
stop 1 stop 1
endif endif
...@@ -488,16 +488,16 @@ ...@@ -488,16 +488,16 @@
#endif #endif
if (istat .ne. 0) then if (istat .ne. 0) then
print *,"bandred_& print *,"bandred_&
&MATH_DATATYPE& &MATH_DATATYPE&
&: error when deallocating umcCUDA "//errorMessage &: error when deallocating umcCUDA "//errorMessage
stop 1 stop 1
endif endif
successCUDA = cuda_malloc(umc_dev, umc_size* size_of_datatype) successCUDA = cuda_malloc(umc_dev, umc_size* size_of_datatype)
if (.not.(successCUDA)) then if (.not.(successCUDA)) then
print *,"bandred_& print *,"bandred_&
&MATH_DATATYPE& &MATH_DATATYPE&
&: error in cudaMalloc umc_dev 2" &: error in cudaMalloc umc_dev 2"
stop 1 stop 1
endif endif
...@@ -512,24 +512,24 @@ ...@@ -512,24 +512,24 @@
allocate(vmrCPU(max(l_rows,1),2*n_cols), stat=istat, errmsg=errorMessage) allocate(vmrCPU(max(l_rows,1),2*n_cols), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then if (istat .ne. 0) then
print *,"bandred_& print *,"bandred_&
&MATH_DATATYPE& &MATH_DATATYPE&
&: error when allocating vmrCPU "//errorMessage &: error when allocating vmrCPU "//errorMessage
stop 1 stop 1
endif endif
allocate(umcCPU(max(l_cols,1),2*n_cols), stat=istat, errmsg=errorMessage) allocate(umcCPU(max(l_cols,1),2*n_cols), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then if (istat .ne. 0) then
print *,"bandred_& print *,"bandred_&
&MATH_DATATYPE& &MATH_DATATYPE&
&: error when allocating umcCPU "//errorMessage &: error when allocating umcCPU "//errorMessage
stop 1 stop 1
endif endif
allocate(vr(l_rows+1), stat=istat, errmsg=errorMessage) allocate(vr(l_rows+1), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then if (istat .ne. 0) then
print *,"bandred_& print *,"bandred_&
&MATH_DATATYPE& &MATH_DATATYPE&
&: error when allocating vr "//errorMessage &: error when allocating vr "//errorMessage
stop 1 stop 1
endif endif
...@@ -603,8 +603,8 @@ ...@@ -603,8 +603,8 @@
if (.not.(successCUDA)) then if (.not.(successCUDA)) then
print *,"bandred_& print *,"bandred_&
&MATH_DATATYPE& &MATH_DATATYPE&
&: error in cudaMemcpy2d" &: error in cudaMemcpy2d"
stop 1 stop 1
endif endif
...@@ -618,8 +618,8 @@ ...@@ -618,8 +618,8 @@
vmrCols = 2*n_cols vmrCols = 2*n_cols
#ifdef USE_ASSUMED_SIZE_QR #ifdef USE_ASSUMED_SIZE_QR
call qr_pdgeqrf_2dcomm_& call qr_pdgeqrf_2dcomm_&
&PRECISION& &PRECISION&
&(obj, a, lda, matrixCols, vmrCPU, max(l_rows,1), vmrCols, tauvector(1), & &(obj, a, lda, matrixCols, vmrCPU, max(l_rows,1), vmrCols, tauvector(1), &
na, tmat(1,1,istep), nbw, nbw, work_blocked, work_size, & na, tmat(1,1,istep), nbw, nbw, work_blocked, work_size, &
work_size, na, n_cols, nblk, nblk, & work_size, na, n_cols, nblk, nblk, &
istep*nbw+n_cols-nbw, istep*nbw+n_cols, 1,& istep*nbw+n_cols-nbw, istep*nbw+n_cols, 1,&
...@@ -628,8 +628,8 @@ ...@@ -628,8 +628,8 @@
#else #else
call qr_pdgeqrf_2dcomm_& call qr_pdgeqrf_2dcomm_&
&PRECISION& &PRECISION&
&(obj, a(1:lda,1:matrixCols), lda, matrixCols, vmrCPU(1:max(l_rows,1),1:vmrCols) , & &(obj, a(1:lda,1:matrixCols), lda, matrixCols, vmrCPU(1:max(l_rows,1),1:vmrCols) , &
max(l_rows,1), vmrCols, tauvector(1:na), na, & max(l_rows,1), vmrCols, tauvector(1:na), na, &
tmat(1:nbw,1:nbw,istep), nbw, nbw, work_blocked(1:work_size), work_size, & tmat(1:nbw,1:nbw,istep), nbw, nbw, work_blocked(1:work_size), work_size, &
work_size, na, n_cols, nblk, nblk, & work_size, na, n_cols, nblk, nblk, &
...@@ -1012,7 +1012,7 @@ ...@@ -1012,7 +1012,7 @@
endif endif
call obj%timer%stop("blas") call obj%timer%stop("blas")
#if REALCASE == 1 #if REALCASE == 1
call symm_matrix_allreduce_& call symm_matrix_allreduce_&
#endif #endif
#if COMPLEXCASE == 1 #if COMPLEXCASE == 1
call herm_matrix_allreduce_& call herm_matrix_allreduce_&
......
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