Commit b97720fb authored by Andreas Marek's avatar Andreas Marek

Move test complex hemitian multiply in seperate file

parent a705ccd2
...@@ -546,93 +546,91 @@ program test ...@@ -546,93 +546,91 @@ program test
#endif #endif
#if defined(TEST_HERMITIAN_MULTIPLY) #if defined(TEST_HERMITIAN_MULTIPLY)
#ifdef TEST_REAL
status = check_correctness_hermitian_multiply(na, a, b, c, na_rows, sc_desc, myid ) status = check_correctness_hermitian_multiply(na, a, b, c, na_rows, sc_desc, myid )
call check_status(status, myid) call check_status(status, myid)
#endif #endif
#ifdef TEST_COMPLEX !#ifdef TEST_COMPLEX
status = 0 ! status = 0
!
!------------------------------------------------------------------------------- ! !-------------------------------------------------------------------------------
! Test correctness of result (using plain scalapack routines) ! ! Test correctness of result (using plain scalapack routines)
allocate(tmp1(na_rows,na_cols)) ! allocate(tmp1(na_rows,na_cols))
allocate(tmp2(na_rows,na_cols)) ! allocate(tmp2(na_rows,na_cols))
#ifdef TEST_DOUBLE !#ifdef TEST_DOUBLE
tmp1(:,:) = (0.0_c_double, 0.0_c_double) ! tmp1(:,:) = (0.0_c_double, 0.0_c_double)
#else !#else
tmp1(:,:) = (0.0_c_float, 0.0_c_float) ! tmp1(:,:) = (0.0_c_float, 0.0_c_float)
#endif !#endif
! tmp1 = a**T ! ! tmp1 = a**T
#ifdef WITH_MPI !#ifdef WITH_MPI
#ifdef TEST_DOUBLE !#ifdef TEST_DOUBLE
call pztranc(na, na, CONE, a, 1, 1, sc_desc, CZERO, tmp1, 1, 1, sc_desc) ! call pztranc(na, na, CONE, a, 1, 1, sc_desc, CZERO, tmp1, 1, 1, sc_desc)
#else !#else
call pctranc(na, na, CONE, a, 1, 1, sc_desc, CZERO, tmp1, 1, 1, sc_desc) ! call pctranc(na, na, CONE, a, 1, 1, sc_desc, CZERO, tmp1, 1, 1, sc_desc)
#endif !#endif
#else !#else
tmp1 = transpose(conjg(a)) ! tmp1 = transpose(conjg(a))
#endif !#endif
! tmp2 = tmp1 * b ! ! tmp2 = tmp1 * b
#ifdef TEST_DOUBLE !#ifdef TEST_DOUBLE
#ifdef WITH_MPI !#ifdef WITH_MPI
call pzgemm("N","N", na, na, na, CONE, tmp1, 1, 1, sc_desc, b, 1, 1, & ! call pzgemm("N","N", na, na, na, CONE, tmp1, 1, 1, sc_desc, b, 1, 1, &
sc_desc, CZERO, tmp2, 1, 1, sc_desc) ! sc_desc, CZERO, tmp2, 1, 1, sc_desc)
#else !#else
call zgemm("N","N", na, na, na, CONE, tmp1, na, b, na, CZERO, tmp2, na) ! call zgemm("N","N", na, na, na, CONE, tmp1, na, b, na, CZERO, tmp2, na)
#endif !#endif
#else !#else
#ifdef WITH_MPI !#ifdef WITH_MPI
call pcgemm("N","N", na, na, na, CONE, tmp1, 1, 1, sc_desc, b, 1, 1, & ! call pcgemm("N","N", na, na, na, CONE, tmp1, 1, 1, sc_desc, b, 1, 1, &
sc_desc, CZERO, tmp2, 1, 1, sc_desc) ! sc_desc, CZERO, tmp2, 1, 1, sc_desc)
#else !#else
call cgemm("N","N", na, na, na, CONE, tmp1, na, b, na, CZERO, tmp2, na) ! call cgemm("N","N", na, na, na, CONE, tmp1, na, b, na, CZERO, tmp2, na)
#endif !#endif
#endif !#endif
!
! compare tmp2 with c ! ! compare tmp2 with c
tmp2(:,:) = tmp2(:,:) - c(:,:) ! tmp2(:,:) = tmp2(:,:) - c(:,:)
#ifdef TEST_DOUBLE !#ifdef TEST_DOUBLE
#ifdef WITH_MPI !#ifdef WITH_MPI
norm = pzlange("M",na, na, tmp2, 1, 1, sc_desc, tmp1) ! norm = pzlange("M",na, na, tmp2, 1, 1, sc_desc, tmp1)
#else !#else
norm = zlange("M",na, na, tmp2, na_rows, tmp1) ! norm = zlange("M",na, na, tmp2, na_rows, tmp1)
#endif !#endif
#else !#else
#ifdef WITH_MPI !#ifdef WITH_MPI
norm = pclange("M",na, na, tmp2, 1, 1, sc_desc, tmp1) ! norm = pclange("M",na, na, tmp2, 1, 1, sc_desc, tmp1)
#else !#else
norm = clange("M",na, na, tmp2, na_rows, tmp1) ! norm = clange("M",na, na, tmp2, na_rows, tmp1)
#endif !#endif
#endif !#endif
#ifdef WITH_MPI !#ifdef WITH_MPI
#ifdef TEST_DOUBLE !#ifdef TEST_DOUBLE
call mpi_allreduce(norm,normmax,1,MPI_REAL8,MPI_MAX,MPI_COMM_WORLD,mpierr) ! call mpi_allreduce(norm,normmax,1,MPI_REAL8,MPI_MAX,MPI_COMM_WORLD,mpierr)
#else !#else
call mpi_allreduce(norm,normmax,1,MPI_REAL4,MPI_MAX,MPI_COMM_WORLD,mpierr) ! call mpi_allreduce(norm,normmax,1,MPI_REAL4,MPI_MAX,MPI_COMM_WORLD,mpierr)
#endif !#endif
#else !#else
normmax = norm ! normmax = norm
#endif !#endif
if (myid .eq. 0) then ! if (myid .eq. 0) then
print *," Maximum error of result: ", normmax ! print *," Maximum error of result: ", normmax
endif ! endif
!
#ifdef TEST_DOUBLE !#ifdef TEST_DOUBLE
if (normmax .gt. 5e-11_c_double) then ! if (normmax .gt. 5e-11_c_double .or. normmax .eq. 0.0_c_double) then
#else !#else
if (normmax .gt. 5e-3_c_float ) then ! if (normmax .gt. 5e-3_c_float .or. normmax .eq. 0.0_c_float) then
#endif !#endif
print *,"norm= ",normmax ! print *,"norm= ",normmax
status = 1 ! status = 1
endif ! endif
!
deallocate(tmp1) ! deallocate(tmp1)
deallocate(tmp2) ! deallocate(tmp2)
!
#endif !#endif
#endif /* TEST_HERMITIAN_MULTIPLY */ !#endif /* TEST_HERMITIAN_MULTIPLY */
if (myid == 0) then if (myid == 0) then
......
...@@ -794,11 +794,12 @@ function check_correctness_evp_numeric_residuals_& ...@@ -794,11 +794,12 @@ function check_correctness_evp_numeric_residuals_&
#endif #endif
#endif /* REALCASE */ #endif /* REALCASE */
#if COMPLEXCASE == 1 #if COMPLEXCASE == 1
#ifdef DOUBLE_PRECISION_COMPLEX #ifdef DOUBLE_PRECISION_COMPLEX
tmp1(:,:) = 0.0_ck8 tmp1(:,:) = (0.0_c_double, 0.0_c_double)
#else #else
tmp1(:,:) = 0.0_ck4 tmp1(:,:) = (0.0_c_float, 0.0_c_float)
#endif #endif
#endif /* COMPLEXCASE */ #endif /* COMPLEXCASE */
...@@ -912,7 +913,6 @@ function check_correctness_evp_numeric_residuals_& ...@@ -912,7 +913,6 @@ function check_correctness_evp_numeric_residuals_&
#ifdef WITH_MPI #ifdef WITH_MPI
#ifdef DOUBLE_PRECISION_COMPLEX #ifdef DOUBLE_PRECISION_COMPLEX
norm = pzlange("M",na, na, tmp2, 1, 1, sc_desc, tmp1) norm = pzlange("M",na, na, tmp2, 1, 1, sc_desc, tmp1)
#else #else
norm = pclange("M",na, na, tmp2, 1, 1, sc_desc, tmp1) norm = pclange("M",na, na, tmp2, 1, 1, sc_desc, tmp1)
......
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