Cleanup. Minor bugs fixed.

C.S.


git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@472 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
sbraccia 2004-01-09 10:20:00 +00:00
parent 406aa7eb33
commit 7da6c0ffb3
4 changed files with 43 additions and 30 deletions

View File

@ -19,12 +19,12 @@ MODULE basic_algebra_routines
!
! ... List of public methods :
!
! x .dot. y implements the dot product between vectors ( <x|y> )
! norm( x ) computes the norm of a vector ( SQRT(<x|x>) )
! A .times. x implements the matrix-vector multiplication ( A|x> )
! x .times. A implements the vector-matrix multiplication ( <x|A )
! matrix( x, y ) implements the vector-vector multiplication ( |x><y| )
! identity( N ) the identity matrix in dimension N
! x .dot. y implements the dot product between vectors ( <x|y> )
! norm( x ) computes the norm of a vector ( SQRT(<x|x>) )
! A .times. x implements the matrix-vector multiplication ( A|x> )
! x .times. A implements the vector-matrix multiplication ( <x|A )
! matrix( x, y ) implements the vector-vector multiplication ( |x><y| )
! identity( N ) the identity matrix in dimension N
!
!
USE parameters, ONLY : DP
@ -53,15 +53,17 @@ MODULE basic_algebra_routines
!
REAL (KIND=DP), INTENT(IN) :: vector1(:), vector2(:)
REAL (KIND=DP) :: internal_dot_product
#if ! defined (__NOBLAS)
#if defined (__NOBLAS)
!
!
internal_dot_product = DOT_PRODUCT( vector1, vector2 )
#else
REAL (KIND=DP) :: DDOT
EXTERNAL DDOT
!
!
internal_dot_product = DDOT( SIZE( vector1 ), vector1, 1, vector2, 1 )
#else
internal_dot_product = DOT_PRODUCT( vector1, vector2 )
#endif
#endif
!
END FUNCTION internal_dot_product
!
@ -74,15 +76,17 @@ MODULE basic_algebra_routines
!
REAL (KIND=DP), INTENT(IN) :: vector(:)
REAL (KIND=DP) :: norm
#if ! defined (__NOBLAS)
#if defined (__NOBLAS)
!
!
norm = SQRT( vector .dot. vector )
#else
REAL (KIND=DP) :: DNRM2
EXTERNAL DNRM2
!
!
norm = DNRM2( SIZE( vector ), vector, 1 )
#else
norm = SQRT( vector .dot. vector )
#endif
#endif
!
END FUNCTION norm
!
@ -104,15 +108,15 @@ MODULE basic_algebra_routines
!
dim = SIZE( vector )
!
#if ! defined (__NOBLAS)
CALL DGEMV( 'N', dim, dim, 1.D0, matrix, dim, vector, 1, &
0.D0, matrix_times_vector, 1 )
#else
#if defined (__NOBLAS)
DO i = 1, dim
!
matrix_times_vector(i) = matrix(i,:) .dot. vector(:)
!
END DO
#else
CALL DGEMV( 'N', dim, dim, 1.D0, matrix, dim, vector, 1, &
0.D0, matrix_times_vector, 1 )
#endif
!
END FUNCTION matrix_times_vector
@ -127,16 +131,24 @@ MODULE basic_algebra_routines
REAL (KIND=DP), INTENT(IN) :: vector(:)
REAL (KIND=DP), INTENT(IN) :: matrix(:,:)
REAL (KIND=DP) :: vector_times_matrix(SIZE( vector ))
INTEGER :: i, dim
INTEGER :: dim
#if defined (__NOBLAS)
INTEGER :: i
#endif
!
!
dim = SIZE( vector )
!
#if defined (__NOBLAS)
DO i = 1, dim
!
vector_times_matrix(i) = vector(:) .dot. matrix(:,i)
!
END DO
#else
CALL DGEMV( 'T', dim, dim, 1.D0, matrix, dim, vector, 1, &
0.D0, matrix_times_vector, 1 )
#endif
!
END FUNCTION vector_times_matrix
!
@ -158,10 +170,7 @@ MODULE basic_algebra_routines
dim1 = SIZE( vector1 )
dim2 = SIZE( vector2 )
!
#if ! defined (__NOBLAS)
CALL DGER( dim1, dim2, 1.D0, &
vector1, 1, vector2, 1, matrix, MAX( dim1, dim2 ) )
#else
#if defined (__NOBLAS)
DO i = 1, dim1
!
DO j = 1, dim2
@ -170,8 +179,11 @@ MODULE basic_algebra_routines
!
END DO
!
END DO
#endif
END DO
#else
CALL DGER( dim1, dim2, 1.D0, &
vector1, 1, vector2, 1, matrix, MAX( dim1, dim2 ) )
#endif
!
END FUNCTION matrix
!

View File

@ -305,7 +305,7 @@ SUBROUTINE c_bands( iter, ik_, dr2 )
WRITE( stdout, '(" DIIS style diagonalization")')
IF ( ethr > diis_ethr_cg ) &
WRITE( stdout, '(6X,"use conjugate-gradient method ", &
&,"until ethr <",1PE9.2)' ) diis_ethr_cg
& "until ethr <",1PE9.2)' ) diis_ethr_cg
ELSE
!
CALL errore( 'c_bands', 'isolve not implemented', 1 )

View File

@ -29,16 +29,16 @@ SUBROUTINE rdiaghg( n, m, h, s, ldh, e, v )
! dimension of the matrix to be diagonalized
! number of eigenstates to be calculated
! leading dimension of h, as declared in the calling pgm unit
REAL(KIND=DP) :: h (ldh, n)
REAL(KIND=DP) :: h(ldh,n)
! matrix to be diagonalized
REAL(KIND=DP) :: s (ldh, n)
REAL(KIND=DP) :: s(ldh,n)
! overlap matrix
!
! ... on OUTPUT
!
REAL(KIND=DP) :: e (n)
REAL(KIND=DP) :: e(n)
! eigenvalues
REAL(KIND=DP) :: v (ldh, m)
REAL(KIND=DP) :: v(ldh,m)
! eigenvectors (column-wise)
!
! ... LOCAL variables

View File

@ -5,6 +5,7 @@
! in the root directory of the present distribution,
! or http://www.gnu.org/copyleft/gpl.txt .
!
#include "machine.h"
!
!-----------------------------------------------------------------------
subroutine vloc_psi(lda, n, m, psi, v, hpsi)