Commit 44122b1f authored by Andreas Marek's avatar Andreas Marek
Browse files

Frank matrix in test programs

parent 4c7521e0
......@@ -23,6 +23,13 @@ gpu_flag = {
matrix_flag = {
"random" : "-DTEST_MATRIX_RANDOM",
"analytic" : "-DTEST_MATRIX_ANALYTIC",
"toeplitz" : "-DTEST_MATRIX_TOEPLITZ",
"frank" : "-DTEST_MATRIX_FRANK",
}
qr_flag = {
0 : "-DTEST_QR_DECOMPOSITION=0",
1 : "-DTEST_QR_DECOMPOSITION=1",
}
test_type_flag = {
......@@ -31,7 +38,6 @@ test_type_flag = {
"solve_tridiagonal" : "-DTEST_SOLVE_TRIDIAGONAL",
"cholesky" : "-DTEST_CHOLESKY",
"hermitian_multiply" : "-DTEST_HERMITIAN_MULTIPLY",
"qr" : "-DTEST_QR_DECOMPOSITION",
}
layout_flag = {
......@@ -39,31 +45,49 @@ layout_flag = {
"square" : ""
}
for m, g, t, p, d, s, l in product(
for m, g, q, t, p, d, s, l in product(
sorted(matrix_flag.keys()),
sorted(gpu_flag.keys()),
sorted(qr_flag.keys()),
sorted(test_type_flag.keys()),
sorted(prec_flag.keys()),
sorted(domain_flag.keys()),
sorted(solver_flag.keys()),
sorted(layout_flag.keys())):
# exclude some test combinations
# analytic tests only for "eigenvectors" and not on GPU
if(m == "analytic" and (g == 1 or t != "eigenvectors")):
continue
# Frank tests only for "eigenvectors" and eigenvalues and real double precision case
if(m == "frank" and ((t != "eigenvectors" or t != "eigenvalues") and (d !="real" or p !="double"))):
continue
if(s in ["scalapack_all", "scalapack_part"] and (g == 1 or t != "eigenvectors" or m != "analytic")):
continue
if (t == "solve_tridiagonal" and (s == "2stage" or d == "complex")):
# solve tridiagonal only for real toeplitz matrix in 1stage
if (t == "solve_tridiagonal" and (s != "1stage" or d !="real" or m != "toeplitz")):
continue
if (t == "cholesky" and (s == "2stage")):
# cholesky tests only 1stage and teoplitz matrix
if (t == "cholesky" and (m != "toeplitz" or s == "2stage")):
continue
if (t == "eigenvalues" and (m == "random")):
continue
if (t == "hermitian_multiply" and (s == "2stage")):
continue
if (t == "qr" and (s == "1stage" or d == "complex")):
if (t == "hermitian_multiply" and (m == "toeplitz")):
continue
# qr only for 2stage real
if (q == 1 and (s != "2stage" or d != "real" or t != "eigenvectors" or g == 1 or m != "random")):
continue
for kernel in ["all_kernels", "default_kernel"] if s == "2stage" else ["nokernel"]:
......@@ -102,13 +126,18 @@ for m, g, t, p, d, s, l in product(
raise Exception("Oh no!")
endifs += 1
name = "test_{0}_{1}_{2}_{3}{4}{5}{6}{7}".format(
name = "test_{0}_{1}_{2}_{3}{4}_{5}{6}{7}{8}".format(
d, p, t, s,
"" if kernel == "nokernel" else "_" + kernel,
"_gpu" if g else "",
"_analytic" if m == "analytic" else "",
"gpu_" if g else "",
"qr_" if q else "",
m,
"_all_layouts" if l == "all_layouts" else "")
print("if BUILD_KCOMPUTER")
print("bin_PROGRAMS += " + name)
print("else")
print("noinst_PROGRAMS += " + name)
print("endif")
print("check_SCRIPTS += " + name + ".sh")
print(name + "_SOURCES = test/Fortran/test.F90")
print(name + "_LDADD = $(test_program_ldadd)")
......@@ -120,6 +149,7 @@ for m, g, t, p, d, s, l in product(
test_type_flag[t],
solver_flag[s],
gpu_flag[g],
qr_flag[q],
matrix_flag[m]] + extra_flags))
print("endif\n" * endifs)
......@@ -145,7 +145,7 @@ program test
logical :: check_all_evals
#if defined(TEST_EIGENVALUES) || defined(TEST_SOLVE_TRIDIAGONAL) || defined(TEST_EIGENVECTORS) || defined(TEST_QR_DECOMPOSITION) || defined(TEST_HERMITIAN_MULTIPLY)
#if defined(TEST_EIGENVALUES) || defined(TEST_SOLVE_TRIDIAGONAL) || defined(TEST_EIGENVECTORS) || TEST_QR_DECOMPOSITION == 1 || defined(TEST_HERMITIAN_MULTIPLY)
EV_TYPE, allocatable :: d(:), sd(:), ds(:), sds(:)
EV_TYPE :: diagonalELement, subdiagonalElement
#endif
......@@ -167,19 +167,12 @@ program test
#endif
integer :: kernel
character(len=1) :: layout
#ifdef TEST_COMPLEX
EV_TYPE :: norm, normmax
MATRIX_TYPE, allocatable :: tmp1(:,:), tmp2(:,:)
#ifdef TEST_DOUBLE
MATRIX_TYPE, parameter :: CONE = (1.0_c_double, 0.0_c_double), &
CZERO = (0.0_c_double, 0.0_c_double)
EV_TYPE :: pzlange, zlange
#else
MATRIX_TYPE, parameter :: CONE = (1.0_c_float, 0.0_c_float), &
CZERO = (0.0_c_float, 0.0_c_float)
EV_TYPE :: pclange, clange
#endif
#endif
logical :: do_test_numeric_residual, do_test_analytic_eigenvalues, &
do_test_analytic_eigenvalues_eigenvectors, &
do_test_frank_eigenvalues, &
do_test_toeplitz_eigenvalues, do_test_cholesky, &
do_test_hermitian_multiply
call read_input_parameters_traditional(na, nev, nblk, write_to_file)
call setup_mpi(myid, nprocs)
#ifdef HAVE_REDIRECT
......@@ -191,6 +184,23 @@ program test
check_all_evals = .true.
do_test_numeric_residual = .false.
do_test_analytic_eigenvalues = .false.
do_test_analytic_eigenvalues_eigenvectors = .false.
do_test_frank_eigenvalues = .false.
do_test_toeplitz_eigenvalues = .false.
do_test_cholesky = .false.
#if defined(TEST_CHOLESKY)
do_test_cholesky = .true.
#endif
do_test_hermitian_multiply = .false.
#if defined(TEST_HERMITIAN_MULTIPLY)
do_test_hermitian_multiply = .true.
#endif
status = 0
if (elpa_init(CURRENT_API_VERSION) /= ELPA_OK) then
print *, "ELPA API version not supported"
stop 1
......@@ -230,14 +240,14 @@ program test
print *,''
endif
#ifdef TEST_QR_DECOMPOSITION
#if TEST_QR_DECOMPOSITION == 1
#if TEST_GPU == 1
#ifdef WITH_MPI
call mpi_finalize(mpierr)
#endif
stop 77
#endif
#endif /* TEST_GPU */
if (nblk .lt. 64) then
if (myid .eq. 0) then
print *,"At the moment QR decomposition need blocksize of at least 64"
......@@ -251,7 +261,8 @@ program test
#endif
stop 77
endif
#endif
#endif /* TEST_QR_DECOMPOSITION */
call set_up_blacsgrid(mpi_comm_world, np_rows, np_cols, layout, &
my_blacs_ctxt, my_prow, my_pcol)
......@@ -269,7 +280,7 @@ program test
allocate(c (na_rows,na_cols))
#endif
#if defined(TEST_EIGENVALUES) || defined(TEST_SOLVE_TRIDIAGONAL) || defined(TEST_EIGENVECTORS) || defined(TEST_QR_DECOMPOSITION) || defined(TEST_CHOLESKY)
#if defined(TEST_EIGENVALUES) || defined(TEST_SOLVE_TRIDIAGONAL) || defined(TEST_EIGENVECTORS) || TEST_QR_DECOMPOSITION == 1|| defined(TEST_CHOLESKY)
allocate(d (na), ds(na))
allocate(sd (na), sds(na))
allocate(ev_analytic(na))
......@@ -279,59 +290,85 @@ program test
z(:,:) = 0.0
ev(:) = 0.0
#if defined(TEST_EIGENVECTORS) || defined(TEST_HERMITIAN_MULTIPLY) || defined(TEST_QR_DECOMPOSITION)
#ifdef TEST_MATRIX_ANALYTIC
call prepare_matrix_analytic(na, a, nblk, myid, np_rows, np_cols, my_prow, my_pcol)
as(:,:) = a
#else
if (nev .ge. 1) then
#if defined(TEST_MATRIX_RANDOM) && !defined(TEST_SOLVE_TRIDIAGONAL) && !defined(TEST_CHOLESKY) && !defined(TEST_EIGENVALUES)
! the random matrix can be used in allmost all tests; but for some no
! correctness checks have been implemented; do not allow these
! combinations
! RANDOM + TEST_SOLVE_TRIDIAGONAL: we need a TOEPLITZ MATRIX
! RANDOM + TEST_CHOLESKY: no correctness check yet implemented
! RANDOM + TEST_EIGENVALUES: no correctness check known
! We also have to take care of special case in TEST_EIGENVECTORS
#if !defined(TEST_EIGENVECTORS)
call prepare_matrix_random(na, myid, sc_desc, a, z, as)
do_test_analytic_eigenvalues = .false.
do_test_analytic_eigenvalues_eigenvectors = .false.
do_test_frank_eigenvalues = .false.
do_test_toeplitz_eigenvalues = .false.
#else /* TEST_EIGENVECTORS */
if (nev .ge. 1) then
call prepare_matrix_random(na, myid, sc_desc, a, z, as)
do_test_analytic_eigenvalues = .false.
do_test_analytic_eigenvalues_eigenvectors = .false.
do_test_frank_eigenvalues = .false.
do_test_toeplitz_eigenvalues = .false.
#ifndef TEST_HERMITIAN_MULTIPLY
do_test_numeric_residual = .true.
#endif
else
! zero eigenvectors and not analytic test => toeplitz matrix
#ifdef TEST_SINGLE
diagonalElement = 0.45_c_float
subdiagonalElement = 0.78_c_float
#else
diagonalElement = 0.45_c_double
subdiagonalElement = 0.78_c_double
if (myid .eq. 0) then
print *,"At the moment with the random matrix you need nev >=1"
endif
#ifdef WITH_MPI
call mpi_finalize(mpierr)
#endif
call prepare_matrix_toeplitz(na, diagonalElement, subdiagonalElement, &
d, sd, ds, sds, a, as, nblk, np_rows, &
np_cols, my_prow, my_pcol)
endif
stop 77
#ifdef TEST_HERMITIAN_MULTIPLY
#ifdef TEST_REAL
endif
#ifdef TEST_DOUBLE
b(:,:) = 2.0_c_double * a(:,:)
c(:,:) = 1.0_c_double
#else
b(:,:) = 2.0_c_float * a(:,:)
c(:,:) = 1.0_c_float
#endif /* TEST_EIGENVECTORS */
#endif /* (TEST_MATRIX_RANDOM) */
#if defined(TEST_MATRIX_RANDOM) && (defined(TEST_SOLVE_TRIDIAGONAL) || defined(TEST_CHOLESKY) || defined(TEST_EIGENVALUES))
#error "Random matrix is not allowed in this configuration"
#endif
#endif
#if defined(TEST_MATRIX_ANALYTIC) && !defined(TEST_SOLVE_TRIDIAGONAL) && !defined(TEST_CHOLESKY)
! the analytic matrix can be used in allmost all tests; but for some no
! correctness checks have been implemented; do not allow these
! combinations
! ANALYTIC + TEST_SOLVE_TRIDIAGONAL: we need a TOEPLITZ MATRIX
! ANALTIC + TEST_CHOLESKY: no correctness check yet implemented
#ifdef TEST_COMPLEX
call prepare_matrix_analytic(na, a, nblk, myid, np_rows, np_cols, my_prow, my_pcol)
as(:,:) = a
#ifdef TEST_DOUBLE
b(:,:) = 2.0_c_double * a(:,:)
c(:,:) = (1.0_c_double, 0.0_c_double)
#else
b(:,:) = 2.0_c_float * a(:,:)
c(:,:) = (1.0_c_float, 0.0_c_float)
do_test_numeric_residual = .false.
do_test_analytic_eigenvalues_eigenvectors = .false.
#ifndef TEST_HERMITIAN_MULTIPLY
do_test_analytic_eigenvalues = .true.
#endif
#if defined(TEST_EIGENVECTORS)
if (nev .ge. 1) then
do_test_analytic_eigenvalues_eigenvectors = .true.
do_test_numeric_residual = .true.
else
do_test_analytic_eigenvalues_eigenvectors = .false.
do_test_numeric_residual = .false.
endif
#endif
#endif /* TEST_HERMITIAN_MULTIPLY */
do_test_frank_eigenvalues = .false.
do_test_toeplitz_eigenvalues = .false.
#endif /* TEST_MATRIX_ANALYTIC */
#endif /* defined(TEST_EIGENVECTORS) || defined(TEST_HERMITIAN_MULTIPLY) || defined(TEST_QR_DECOMPOSITION) */
#if defined(TEST_EIGENVALUES) || defined(TEST_SOLVE_TRIDIAGONAL)
#if defined(TEST_MATRIX_ANALYTIC) && (defined(TEST_SOLVE_TRIDIAGONAL) || defined(TEST_CHOLESKY))
#error "Analytic matrix is not allowd in this configuration"
#endif
#if defined(TEST_MATRIX_TOEPLITZ)
! The Toeplitz matrix works in each test
#ifdef TEST_SINGLE
diagonalElement = 0.45_c_float
subdiagonalElement = 0.78_c_float
......@@ -339,13 +376,8 @@ program test
diagonalElement = 0.45_c_double
subdiagonalElement = 0.78_c_double
#endif
call prepare_matrix_toeplitz(na, diagonalElement, subdiagonalElement, &
d, sd, ds, sds, a, as, nblk, np_rows, &
np_cols, my_prow, my_pcol)
#endif /* EIGENVALUES OR TRIDIAGONAL */
#if defined(TEST_CHOLESKY)
#ifdef TEST_SINGLE
diagonalElement = (2.546_c_float, 0.0_c_float)
subdiagonalElement = (0.0_c_float, 0.0_c_float)
......@@ -353,12 +385,107 @@ program test
diagonalElement = (2.546_c_double, 0.0_c_double)
subdiagonalElement = (0.0_c_double, 0.0_c_double)
#endif
#endif /* TEST_CHOLESKY */
call prepare_matrix_toeplitz(na, diagonalElement, subdiagonalElement, &
d, sd, ds, sds, a, as, nblk, np_rows, &
np_cols, my_prow, my_pcol)
#endif /* TEST_CHOLESKY */
do_test_numeric_residual = .false.
#if defined(TEST_EIGENVECTORS)
if (nev .ge. 1) then
do_test_numeric_residual = .true.
else
do_test_numeric_residual = .false.
endif
#endif
do_test_analytic_eigenvalues = .false.
do_test_analytic_eigenvalues_eigenvectors = .false.
do_test_frank_eigenvalues = .false.
#if defined(TEST_CHOLESKY)
do_test_toeplitz_eigenvalues = .false.
#else
do_test_toeplitz_eigenvalues = .true.
#endif
#endif /* TEST_MATRIX_TOEPLITZ */
#if defined(TEST_MATRIX_FRANK) && !defined(TEST_SOLVE_TRIDIAGONAL) && !defined(TEST_CHOLESKY)
! the random matrix can be used in allmost all tests; but for some no
! correctness checks have been implemented; do not allow these
! combinations
! FRANK + TEST_SOLVE_TRIDIAGONAL: we need a TOEPLITZ MATRIX
! FRANK + TEST_CHOLESKY: no correctness check yet implemented
! We also have to take care of special case in TEST_EIGENVECTORS
#if !defined(TEST_EIGENVECTORS)
call prepare_matrix_frank(na, a, z, as, nblk, np_rows, np_cols, my_prow, my_pcol)
do_test_analytic_eigenvalues = .false.
do_test_analytic_eigenvalues_eigenvectors = .false.
#ifndef TEST_HERMITIAN_MULTIPLY
do_test_frank_eigenvalues = .true.
#endif
do_test_toeplitz_eigenvalues = .false.
#else /* TEST_EIGENVECTORS */
if (nev .ge. 1) then
call prepare_matrix_frank(na, a, z, as, nblk, np_rows, np_cols, my_prow, my_pcol)
do_test_analytic_eigenvalues = .false.
do_test_analytic_eigenvalues_eigenvectors = .false.
#ifndef TEST_HERMITIAN_MULTIPLY
do_test_frank_eigenvalues = .true.
#endif
do_test_toeplitz_eigenvalues = .false.
do_test_numeric_residual = .false.
else
do_test_analytic_eigenvalues = .false.
do_test_analytic_eigenvalues_eigenvectors = .false.
#ifndef TEST_HERMITIAN_MULTIPLY
do_test_frank_eigenvalues = .true.
#endif
do_test_toeplitz_eigenvalues = .false.
do_test_numeric_residual = .false.
endif
#endif /* TEST_EIGENVECTORS */
#endif /* (TEST_MATRIX_FRANK) */
#if defined(TEST_MATRIX_FRANK) && (defined(TEST_SOLVE_TRIDIAGONAL) || defined(TEST_CHOLESKY))
#error "FRANK matrix is not allowed in this configuration"
#endif
#ifdef TEST_HERMITIAN_MULTIPLY
#ifdef TEST_REAL
#ifdef TEST_DOUBLE
b(:,:) = 2.0_c_double * a(:,:)
c(:,:) = 0.0_c_double
#else
b(:,:) = 2.0_c_float * a(:,:)
c(:,:) = 0.0_c_float
#endif
#endif /* TEST_REAL */
#ifdef TEST_COMPLEX
#ifdef TEST_DOUBLE
b(:,:) = 2.0_c_double * a(:,:)
c(:,:) = (0.0_c_double, 0.0_c_double)
#else
b(:,:) = 2.0_c_float * a(:,:)
c(:,:) = (0.0_c_float, 0.0_c_float)
#endif
#endif /* TEST_COMPLEX */
#endif /* TEST_HERMITIAN_MULTIPLY */
e => elpa_allocate()
......@@ -381,22 +508,20 @@ program test
call e%set("process_col", my_pcol, error)
assert_elpa_ok(error)
#endif
call e%set("timings",1)
call e%set("timings",1,error)
assert_elpa_ok(e%setup())
#ifdef TEST_SOLVER_1STAGE
call e%set("solver", ELPA_SOLVER_1STAGE)
call e%set("solver", ELPA_SOLVER_1STAGE,error)
#else
call e%set("solver", ELPA_SOLVER_2STAGE)
call e%set("solver", ELPA_SOLVER_2STAGE,error)
#endif
assert_elpa_ok(error)
call e%set("gpu", TEST_GPU, error)
assert_elpa_ok(error)
#ifdef TEST_QR_DECOMPOSITION
#if TEST_QR_DECOMPOSITION == 1
call e%set("qr", 1, error)
assert_elpa_ok(error)
#endif
......@@ -420,7 +545,7 @@ program test
cycle
endif
! actually used kernel might be different if forced via environment variables
call e%get(KERNEL_KEY, kernel)
call e%get(KERNEL_KEY, kernel, error)
#endif
if (myid == 0) then
print *, elpa_int_value_to_string(KERNEL_KEY, kernel) // " kernel"
......@@ -432,8 +557,12 @@ program test
#endif
! The actual solve step
#if defined(TEST_EIGENVECTORS) || defined(TEST_QR_DECOMPOSITION)
#if defined(TEST_EIGENVECTORS)
#if TEST_QR_DECOMPOSITION == 1
call e%timer_start("e%eigenvectors_qr()")
#else
call e%timer_start("e%eigenvectors()")
#endif
#ifdef TEST_SCALAPACK_ALL
call solve_scalapack_all(na, a, sc_desc, ev, z)
#elif TEST_SCALAPACK_PART
......@@ -442,8 +571,12 @@ program test
#else
call e%eigenvectors(a, ev, z, error)
#endif
#if TEST_QR_DECOMPOSITION == 1
call e%timer_stop("e%eigenvectors_qr()")
#else
call e%timer_stop("e%eigenvectors()")
#endif /* TEST_EIGENVECTORS || defined(TEST_QR_DECOMPOSITION) */
#endif
#endif /* TEST_EIGENVECTORS */
#ifdef TEST_EIGENVALUES
call e%timer_start("e%eigenvalues()")
......@@ -481,9 +614,13 @@ program test
call e%print_times(elpa_int_value_to_string(KERNEL_KEY, kernel))
#else /* TEST_ALL_KERNELS */
#if defined(TEST_EIGENVECTORS) || defined(TEST_QR_DECOMPOSITION)
#if defined(TEST_EIGENVECTORS)
#if TEST_QR_DECOMPOSITION == 1
call e%print_times("e%eigenvectors_qr()")
#else
call e%print_times("e%eigenvectors()")
#endif
#endif
#ifdef TEST_EIGENVALUES
call e%print_times("e%eigenvalues()")
#endif
......@@ -499,139 +636,52 @@ program test
#endif /* TEST_ALL_KERNELS */
endif
#if defined(TEST_EIGENVECTORS) || defined(TEST_QR_DECOMPOSITION)
#ifdef TEST_MATRIX_ANALYTIC
status = check_correctness_analytic(na, nev, ev, z, nblk, myid, np_rows, np_cols, my_prow, my_pcol, check_all_evals)
#else
!#elif defined(TEST_MATRIX_FRANK)
! status = check_correctness_evp_numeric_residuals(na, nev, as, z, ev, sc_desc, nblk, myid, np_rows,np_cols, my_prow, my_pcol)
!#elif defined(TEST_MATRIX_RANDOM)
if (nev .ge. 1) then
if (do_test_analytic_eigenvalues) then
status = check_correctness_analytic(na, nev, ev, z, nblk, myid, np_rows, np_cols, my_prow, my_pcol, check_all_evals, .false.)
call check_status(status, myid)
endif
if (do_test_analytic_eigenvalues_eigenvectors) then
status = check_correctness_analytic(na, nev, ev, z, nblk, myid, np_rows, np_cols, my_prow, my_pcol, check_all_evals, .true.)
call check_status(status, myid)
endif
if(do_test_numeric_residual) then
status = check_correctness_evp_numeric_residuals(na, nev, as, z, ev, sc_desc, nblk, myid, np_rows,np_cols, my_prow, my_pcol)
else
! zero eigenvectors and no analytic test => toeplitz
status = check_correctness_eigenvalues_toeplitz(na, diagonalElement, &
subdiagonalElement, ev, z, myid)
call check_status(status, myid)
endif
if (do_test_frank_eigenvalues) then
status = check_correctness_eigenvalues_frank(na, ev, z, myid)
call check_status(status, myid)
endif
call check_status(status, myid)
!#else
!#error "MATRIX TYPE"
!#endif
#endif
#endif /* defined(TEST_EIGENVECTORS) || defined(TEST_QR_DECOMPOSITION) */
if (do_test_toeplitz_eigenvalues) then
#if defined(TEST_EIGENVALUES) || defined(TEST_SOLVE_TRIDIAGONAL)
status = check_correctness_eigenvalues_toeplitz(na, diagonalElement, &
status = check_correctness_eigenvalues_toeplitz(na, diagonalElement, &
subdiagonalElement, ev, z, myid)
call check_status(status, myid)
#ifdef TEST_SOLVE_TRIDIAGONAL
! check eigenvectors
status = check_correctness_evp_numeric_residuals(na, nev, as, z, ev, sc_desc, nblk, myid, np_rows, np_cols, my_prow, my_pcol)
call check_status(status, myid)
#endif
call check_status(status, myid)
#endif
endif
#if defined(TEST_CHOLESKY)
status = check_correctness_cholesky(na, a, as, na_rows, sc_desc, myid )
call check_status(status, myid)
#endif
if (do_test_cholesky) then
status = check_correctness_cholesky(na, a, as, na_rows, sc_desc, myid )
call check_status(status, myid)
endif
#if defined(TEST_HERMITIAN_MULTIPLY)
status = check_correctness_hermitian_multiply(na, a, b, c, na_rows, sc_desc, myid )
call check_status(status, myid)
#ifdef TEST_HERMITIAN_MULTIPLY
if (do_test_hermitian_multiply) then
status = check_correctness_hermitian_multiply(na, a, b, c, na_rows, sc_desc, myid )
call check_status(status, myid)
endif
#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))