Commit 94a4dc99 authored by Andreas Marek's avatar Andreas Marek

Unify real/complex function calls in elpa_invert_trm.X90

parent 738b4615
......@@ -109,26 +109,22 @@
if (my_pcol==pcol(n, nblk, np_cols)) then
call timer%start("blas")
#if REALCASE == 1
#ifdef DOUBLE_PRECISION_REAL
call DTRTRI('U', 'N', nb, a(l_row1,l_col1), lda, info)
#else
call STRTRI('U', 'N', nb, a(l_row1,l_col1), lda, info)
#endif
#endif
#if COMPLEXCASE == 1
#ifdef DOUBLE_PRECISION_COMPLEX
call ZTRTRI('U', 'N', nb, a(l_row1,l_col1), lda, info)
#else
call CTRTRI('U', 'N', nb, a(l_row1,l_col1), lda, info)
#endif
#endif
call PRECISION_TRTRI('U', 'N', nb, a(l_row1,l_col1), lda, info)
call timer%stop("blas")
if (info/=0) then
if (wantDebug) write(error_unit,*) "elpa_invert_trm_&
&MATH_DATATYPE&
#if REALCASE == 1
&: Error in DTRTRI"
#endif
#if COMPLEXCASE == 1
&: Error in ZTRTRI"
#endif
success = .false.
return
endif
......@@ -159,20 +155,14 @@
call timer%start("blas")
if (l_cols-l_colx+1>0) &
call PRECISION_TRMM ('L', 'U', 'N', 'N', nb, l_cols-l_colx+1, &
#if REALCASE == 1
#ifdef DOUBLE_PRECISION_REAL
call DTRMM('L', 'U', 'N', 'N', nb, l_cols-l_colx+1, 1.0_rk8, tmp2, ubound(tmp2,dim=1), a(l_row1,l_colx), lda)
#else
call STRMM('L', 'U', 'N', 'N', nb, l_cols-l_colx+1, 1.0_rk4, tmp2, ubound(tmp2,dim=1), a(l_row1,l_colx), lda)
#endif
CONST_1_0, &
#endif
#if COMPLEXCASE == 1
#ifdef DOUBLE_PRECISION_COMPLEX
call ZTRMM('L', 'U', 'N', 'N', nb, l_cols-l_colx+1, (1.0_rk8,0.0_rk8), tmp2, ubound(tmp2,dim=1), a(l_row1,l_colx), lda)
#else
call CTRMM('L', 'U', 'N', 'N', nb, l_cols-l_colx+1, (1.0_rk4,0.0_rk4), tmp2, ubound(tmp2,dim=1), a(l_row1,l_colx), lda)
#endif
CONST_COMPLEX_PAIR_1_0, &
#endif
tmp2, ubound(tmp2,dim=1), a(l_row1,l_colx), lda)
call timer%stop("blas")
if (l_colx<=l_cols) tmat2(1:nb,l_colx:l_cols) = a(l_row1:l_row1+nb-1,l_colx:l_cols)
if (my_pcol==pcol(n, nblk, np_cols)) tmat2(1:nb,l_col1:l_col1+nb-1) = tmp2(1:nb,1:nb) ! tmp2 has the lower left triangle 0
......@@ -218,16 +208,22 @@
call timer%start("blas")
if (l_row1>1 .and. l_cols-l_col1+1>0) &
call PRECISION_GEMM('N', 'N', l_row1-1, l_cols-l_col1+1, nb, &
#if REALCASE == 1
-CONST_1_0, &
#endif
#if COMPLEXCASE == 1
-CONST_COMPLEX_PAIR_1_0, &
#endif
tmat1, ubound(tmat1,dim=1), tmat2(1,l_col1), ubound(tmat2,dim=1), &
#if REALCASE == 1
call PRECISION_GEMM('N', 'N', l_row1-1, l_cols-l_col1+1, nb, -CONST_1_0, &
tmat1, ubound(tmat1,dim=1), tmat2(1,l_col1), ubound(tmat2,dim=1), &
CONST_1_0, a(1,l_col1), lda)
CONST_1_0, &
#endif
#if COMPLEXCASE == 1
call PRECISION_GEMM('N', 'N', l_row1-1, l_cols-l_col1+1, nb, -CONST_COMPLEX_PAIR_1_0, &
tmat1, ubound(tmat1,dim=1), tmat2(1,l_col1), ubound(tmat2,dim=1), &
CONST_COMPLEX_PAIR_1_0, a(1,l_col1), lda)
CONST_COMPLEX_PAIR_1_0, &
#endif
a(1,l_col1), lda)
call timer%stop("blas")
enddo
......
......@@ -6,6 +6,7 @@
#undef PRECISION_STR
#undef REAL_DATATYPE
#undef PRECISION_TRTRI
#undef PRECISION_POTRF
#undef PRECISION_TRSM
#undef PRECISION_GEMV
......@@ -52,6 +53,8 @@
#define PRECISION_SUFFIX "_double"
#define REAL_DATATYPE rk8
#define PRECISION_TRTRI DTRTRI
#define PRECISION_POTRF DPOTRF
#define PRECISION_TRSM DTRSM
#define PRECISION_GEMV DGEMV
......@@ -95,6 +98,7 @@
#define PRECISION_SUFFIX "_single"
#define REAL_DATATYPE rk4
#define PRECISION_TRTRI STRTRI
#define PRECISION_POTRF SPOTRF
#define PRECISION_TRSM STRSM
#define PRECISION_GEMV SGEMV
......@@ -142,6 +146,7 @@
/* in the complex case also sometime real valued variables are needed */
#undef REAL_DATATYPE
#undef PRECISION_TRTRI
#undef PRECISION_POTRF
#undef PRECISION_TRSM
#undef PRECISION_STR
......@@ -200,6 +205,7 @@
#define COMPLEX_DATATYPE CK8
#define REAL_DATATYPE RK8
#define PRECISION_TRTRI ZTRTRI
#define PRECISION_POTRF ZPOTRF
#define PRECISION_TRSM ZTRSM
#define PRECISION_GEMV ZGEMV
......@@ -253,6 +259,7 @@
#define COMPLEX_DATATYPE CK4
#define REAL_DATATYPE RK4
#define PRECISION_TRTRI CTRTRI
#define PRECISION_POTRF CPOTRF
#define PRECISION_TRSM CTRSM
#define PRECISION_GEMV CGEMV
......
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