From 188e125b66f4bd33e4428e970ff4ca77d288bfbc Mon Sep 17 00:00:00 2001 From: Carlo Cavazzoni Date: Tue, 13 Aug 2019 02:57:08 +0200 Subject: [PATCH] - adding missing interfaces for non scalapack build --- LAXlib/cdiaghg.f90 | 5 +++-- LAXlib/laxlib_mid.fh | 44 ++++++++++++++++++++++++++++++++++++++++++++ LAXlib/ptoolkit.f90 | 33 +++++++++++++++++++++++++-------- LAXlib/rdiaghg.f90 | 7 ++++--- 4 files changed, 76 insertions(+), 13 deletions(-) diff --git a/LAXlib/cdiaghg.f90 b/LAXlib/cdiaghg.f90 index d7799a4b8..6a44ab347 100644 --- a/LAXlib/cdiaghg.f90 +++ b/LAXlib/cdiaghg.f90 @@ -215,6 +215,7 @@ SUBROUTINE laxlib_pcdiaghg( n, h, s, ldh, e, v, idesc ) IMPLICIT NONE ! include 'laxlib_param.fh' + include 'laxlib_mid.fh' include 'laxlib_low.fh' ! INTEGER, INTENT(IN) :: n, ldh @@ -280,7 +281,7 @@ SUBROUTINE laxlib_pcdiaghg( n, h, s, ldh, e, v, idesc ) IF( info /= 0 ) CALL lax_error__( ' cdiaghg ', ' problems computing cholesky ', ABS( info ) ) #else - CALL qe_pzpotrf( ss, nx, n, desc ) + CALL qe_pzpotrf( ss, nx, n, idesc ) #endif ! END IF @@ -303,7 +304,7 @@ SUBROUTINE laxlib_pcdiaghg( n, h, s, ldh, e, v, idesc ) ! IF( info /= 0 ) CALL lax_error__( ' cdiaghg ', ' problems computing inverse ', ABS( info ) ) #else - CALL qe_pztrtri( ss, nx, n, desc ) + CALL qe_pztrtri( ss, nx, n, idesc ) #endif ! END IF diff --git a/LAXlib/laxlib_mid.fh b/LAXlib/laxlib_mid.fh index eadb31bc7..263c7caa5 100644 --- a/LAXlib/laxlib_mid.fh +++ b/LAXlib/laxlib_mid.fh @@ -32,3 +32,47 @@ SUBROUTINE qe_pzheevd_x( tv, n, idesc, hh, ldh, e ) REAL(DP) :: e( n ) END SUBROUTINE END INTERFACE + +INTERFACE qe_pzpotrf +SUBROUTINE qe_pzpotrf_x( sll, ldx, n, idesc ) + implicit none + include 'laxlib_param.fh' + INTEGER, PARAMETER :: DP = selected_real_kind(14,200) + integer :: n, ldx + integer, INTENT(IN) :: idesc(LAX_DESC_SIZE) + complex(DP) :: sll( ldx, ldx ) +END SUBROUTINE +END INTERFACE + +INTERFACE qe_pdpotrf +SUBROUTINE qe_pdpotrf_x( sll, ldx, n, idesc ) + implicit none + include 'laxlib_param.fh' + INTEGER, PARAMETER :: DP = selected_real_kind(14,200) + integer :: n, ldx + INTEGER, INTENT(IN) :: idesc(LAX_DESC_SIZE) + REAL(DP) :: sll( ldx, ldx ) +END SUBROUTINE +END INTERFACE + +INTERFACE qe_pztrtri +SUBROUTINE qe_pztrtri_x ( sll, ldx, n, idesc ) + implicit none + include 'laxlib_param.fh' + INTEGER, PARAMETER :: DP = selected_real_kind(14,200) + INTEGER, INTENT( IN ) :: n, ldx + INTEGER, INTENT(IN) :: idesc(LAX_DESC_SIZE) + COMPLEX(DP), INTENT( INOUT ) :: sll( ldx, ldx ) +END SUBROUTINE +END INTERFACE + +INTERFACE qe_pdtrtri +SUBROUTINE qe_pdtrtri_x ( sll, ldx, n, idesc ) + implicit none + include 'laxlib_param.fh' + INTEGER, PARAMETER :: DP = selected_real_kind(14,200) + INTEGER, INTENT( IN ) :: n, ldx + INTEGER, INTENT(IN) :: idesc(LAX_DESC_SIZE) + REAL(DP), INTENT( INOUT ) :: sll( ldx, ldx ) +END SUBROUTINE +END INTERFACE diff --git a/LAXlib/ptoolkit.f90 b/LAXlib/ptoolkit.f90 index 3cfb01f84..20fdc8198 100644 --- a/LAXlib/ptoolkit.f90 +++ b/LAXlib/ptoolkit.f90 @@ -3178,15 +3178,17 @@ END SUBROUTINE blk2cyc_zredist_x ! ! -SUBROUTINE qe_pzpotrf_x( sll, ldx, n, desc ) +SUBROUTINE qe_pzpotrf_x( sll, ldx, n, idesc ) ! USE descriptors USE la_param ! implicit none ! + include 'laxlib_param.fh' + ! integer :: n, ldx - TYPE(la_descriptor), INTENT(IN) :: desc + integer, INTENT(IN) :: idesc(LAX_DESC_SIZE) real(DP) :: one, zero complex(DP) :: sll( ldx, ldx ), cone, czero integer :: myrow, mycol, ierr @@ -3197,6 +3199,7 @@ SUBROUTINE qe_pzpotrf_x( sll, ldx, n, desc ) integer :: nr, nc integer :: rcomm, ccomm, color, key, myid, np complex(DP), allocatable :: ssnd( :, : ), srcv( :, : ) + TYPE(la_descriptor) :: desc one = 1.0_DP cone = 1.0_DP @@ -3205,6 +3208,8 @@ SUBROUTINE qe_pzpotrf_x( sll, ldx, n, desc ) #if defined __MPI + CALL laxlib_intarray_to_desc(desc,idesc) + myrow = desc%myr mycol = desc%myc myid = desc%mype @@ -3407,15 +3412,17 @@ END SUBROUTINE qe_pzpotrf_x ! now the Double Precision subroutine -SUBROUTINE qe_pdpotrf_x( sll, ldx, n, desc ) +SUBROUTINE qe_pdpotrf_x( sll, ldx, n, idesc ) ! USE descriptors USE la_param ! implicit none ! + include 'laxlib_param.fh' + ! integer :: n, ldx - TYPE(la_descriptor), INTENT(IN) :: desc + INTEGER, INTENT(IN) :: idesc(LAX_DESC_SIZE) REAL(DP) :: one, zero REAL(DP) :: sll( ldx, ldx ) integer :: myrow, mycol, ierr @@ -3426,12 +3433,15 @@ SUBROUTINE qe_pdpotrf_x( sll, ldx, n, desc ) integer :: nr, nc integer :: rcomm, ccomm, color, key, myid, np REAL(DP), ALLOCATABLE :: ssnd( :, : ), srcv( :, : ) + TYPE(la_descriptor) :: desc one = 1.0_DP zero = 0.0_DP #if defined __MPI + CALL laxlib_intarray_to_desc(desc,idesc) + myrow = desc%myr mycol = desc%myc myid = desc%mype @@ -3634,7 +3644,7 @@ END SUBROUTINE qe_pdpotrf_x ! ! -SUBROUTINE qe_pztrtri_x ( sll, ldx, n, desc ) +SUBROUTINE qe_pztrtri_x ( sll, ldx, n, idesc ) ! pztrtri computes the parallel inversion of a lower triangular matrix ! distribuited among the processes using a 2-D block partitioning. @@ -3667,9 +3677,10 @@ SUBROUTINE qe_pztrtri_x ( sll, ldx, n, desc ) USE la_param IMPLICIT NONE + INCLUDE 'laxlib_param.fh' INTEGER, INTENT( IN ) :: n, ldx - TYPE(la_descriptor), INTENT(IN) :: desc + INTEGER, INTENT(IN) :: idesc(LAX_DESC_SIZE) COMPLEX(DP), INTENT( INOUT ) :: sll( ldx, ldx ) COMPLEX(DP), PARAMETER :: ONE = (1.0_DP, 0.0_DP) @@ -3692,7 +3703,9 @@ SUBROUTINE qe_pztrtri_x ( sll, ldx, n, desc ) ! B and BUF_RECV are used to overload the computation of matrix multiplication and the shift of the blocks COMPLEX(DP), ALLOCATABLE, DIMENSION( :, : ) :: B, C, BUF_RECV COMPLEX(DP) :: first + TYPE(la_descriptor) :: desc + CALL laxlib_intarray_to_desc(desc,idesc) myrow = desc%myr mycol = desc%myc myid = desc%mype @@ -3994,7 +4007,7 @@ END SUBROUTINE qe_pztrtri_x ! now the Double Precision subroutine -SUBROUTINE qe_pdtrtri_x ( sll, ldx, n, desc ) +SUBROUTINE qe_pdtrtri_x ( sll, ldx, n, idesc ) ! pztrtri computes the parallel inversion of a lower triangular matrix ! distribuited among the processes using a 2-D block partitioning. @@ -4027,9 +4040,10 @@ SUBROUTINE qe_pdtrtri_x ( sll, ldx, n, desc ) USE la_param IMPLICIT NONE + include 'laxlib_param.fh' INTEGER, INTENT( IN ) :: n, ldx - TYPE(la_descriptor), INTENT(IN) :: desc + INTEGER, INTENT(IN) :: idesc(LAX_DESC_SIZE) REAL(DP), INTENT( INOUT ) :: sll( ldx, ldx ) REAL(DP), PARAMETER :: ONE = 1.0_DP @@ -4052,6 +4066,9 @@ SUBROUTINE qe_pdtrtri_x ( sll, ldx, n, desc ) ! B and BUF_RECV are used to overload the computation of matrix multiplication and the shift of the blocks REAL(DP), ALLOCATABLE, DIMENSION( :, : ) :: B, C, BUF_RECV REAL(DP) :: first + TYPE(la_descriptor) :: desc + + CALL laxlib_intarray_to_desc(desc,idesc) myrow = desc%myr mycol = desc%myc diff --git a/LAXlib/rdiaghg.f90 b/LAXlib/rdiaghg.f90 index 207891da7..d14819df5 100644 --- a/LAXlib/rdiaghg.f90 +++ b/LAXlib/rdiaghg.f90 @@ -204,6 +204,7 @@ SUBROUTINE laxlib_prdiaghg( n, h, s, ldh, e, v, idesc ) ! include 'laxlib_param.fh' include 'laxlib_low.fh' + include 'laxlib_mid.fh' ! INTEGER, INTENT(IN) :: n, ldh ! dimension of the matrix to be diagonalized and number of eigenstates to be calculated @@ -270,7 +271,7 @@ SUBROUTINE laxlib_prdiaghg( n, h, s, ldh, e, v, idesc ) CALL PDPOTRF( 'L', n, ss, 1, 1, desch, info ) IF( info /= 0 ) CALL lax_error__( ' rdiaghg ', ' problems computing cholesky ', ABS( info ) ) #else - CALL qe_pdpotrf( ss, nx, n, desc ) + CALL qe_pdpotrf( ss, nx, n, idesc ) #endif ! END IF @@ -291,7 +292,7 @@ SUBROUTINE laxlib_prdiaghg( n, h, s, ldh, e, v, idesc ) ! IF( info /= 0 ) CALL lax_error__( ' rdiaghg ', ' problems computing inverse ', ABS( info ) ) #else - CALL qe_pdtrtri ( ss, nx, n, desc ) + CALL qe_pdtrtri ( ss, nx, n, idesc ) #endif ! END IF @@ -325,7 +326,7 @@ SUBROUTINE laxlib_prdiaghg( n, h, s, ldh, e, v, idesc ) #if defined(__SCALAPACK) CALL pdsyevd_drv( .true., n, desc%nrcx, hh, SIZE(hh,1), e, ortho_cntx, ortho_comm ) #else - CALL qe_pdsyevd( .true., n, desc, hh, SIZE(hh,1), e ) + CALL qe_pdsyevd( .true., n, idesc, hh, SIZE(hh,1), e ) #endif ! END IF