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