2003-01-20 05:58:50 +08:00
|
|
|
!
|
2006-02-04 04:20:55 +08:00
|
|
|
! Copyright (C) 2001-2005 Quantum-ESPRESSO group
|
2003-01-20 05:58:50 +08:00
|
|
|
! This file is distributed under the terms of the
|
|
|
|
! GNU General Public License. See the file `License'
|
|
|
|
! in the root directory of the present distribution,
|
|
|
|
! or http://www.gnu.org/copyleft/gpl.txt .
|
|
|
|
!
|
2004-06-26 01:25:37 +08:00
|
|
|
#include "f_defs.h"
|
2003-01-20 05:58:50 +08:00
|
|
|
!
|
2004-01-20 20:26:22 +08:00
|
|
|
!----------------------------------------------------------------------------
|
|
|
|
SUBROUTINE cdiagh( n, h, ldh, e, v )
|
|
|
|
!----------------------------------------------------------------------------
|
|
|
|
!
|
|
|
|
! ... calculates all the eigenvalues and eigenvectors of a complex
|
2006-02-04 04:20:55 +08:00
|
|
|
! ... hermitean matrix H. On output, the matrix is unchanged
|
2004-01-20 20:26:22 +08:00
|
|
|
!
|
2006-02-04 04:20:55 +08:00
|
|
|
USE kinds, ONLY : DP
|
|
|
|
USE control_flags, ONLY : use_para_diago, para_diago_dim
|
|
|
|
USE mp_global, ONLY : nproc, npool, nproc_pool, me_pool, &
|
|
|
|
root_pool, intra_pool_comm, my_image_id
|
|
|
|
USE mp, ONLY : mp_bcast
|
|
|
|
USE parallel_toolkit, ONLY : cdiagonalize
|
2004-01-20 20:26:22 +08:00
|
|
|
!
|
|
|
|
IMPLICIT NONE
|
|
|
|
!
|
|
|
|
! ... on INPUT
|
|
|
|
!
|
2006-02-04 04:20:55 +08:00
|
|
|
INTEGER :: n, ldh
|
|
|
|
! dimension of the matrix to be diagonalized
|
|
|
|
! leading dimension of h, as declared in the calling pgm unit
|
|
|
|
COMPLEX(DP) :: h(ldh,n)
|
|
|
|
! matrix to be diagonalized
|
2004-01-20 20:26:22 +08:00
|
|
|
!
|
|
|
|
! ... on OUTPUT
|
|
|
|
!
|
2005-08-28 22:09:42 +08:00
|
|
|
REAL(DP) :: e(n) ! eigenvalues
|
|
|
|
COMPLEX(DP) :: v(ldh,n) ! eigenvectors (column-wise)
|
2004-01-20 20:26:22 +08:00
|
|
|
!
|
|
|
|
CALL start_clock( 'cdiagh' )
|
|
|
|
!
|
2006-02-04 04:20:55 +08:00
|
|
|
IF ( use_para_diago .AND. n > para_diago_dim ) THEN
|
|
|
|
!
|
2006-02-07 21:46:56 +08:00
|
|
|
CALL cdiagonalize( 1, h, ldh, e, v, ldh, n, &
|
2006-02-04 04:20:55 +08:00
|
|
|
nproc_pool, me_pool, intra_pool_comm )
|
|
|
|
!
|
|
|
|
ELSE
|
|
|
|
!
|
2006-03-17 02:04:33 +08:00
|
|
|
#if defined (__ESSL)
|
2006-02-04 04:20:55 +08:00
|
|
|
CALL cdiagh_aix()
|
2006-01-27 00:42:14 +08:00
|
|
|
#else
|
2006-02-04 04:20:55 +08:00
|
|
|
CALL cdiagh_lapack( v )
|
2003-01-20 05:58:50 +08:00
|
|
|
#endif
|
2006-02-04 04:20:55 +08:00
|
|
|
!
|
|
|
|
END IF
|
2004-01-20 20:26:22 +08:00
|
|
|
!
|
|
|
|
CALL stop_clock( 'cdiagh' )
|
|
|
|
!
|
|
|
|
RETURN
|
|
|
|
!
|
|
|
|
CONTAINS
|
|
|
|
!
|
2004-03-08 01:18:22 +08:00
|
|
|
! ... internal procedures
|
|
|
|
!
|
2006-03-17 02:04:33 +08:00
|
|
|
#if defined (__ESSL)
|
2004-01-20 20:26:22 +08:00
|
|
|
!
|
|
|
|
!-----------------------------------------------------------------------
|
|
|
|
SUBROUTINE cdiagh_aix()
|
|
|
|
!-----------------------------------------------------------------------
|
|
|
|
!
|
|
|
|
IMPLICIT NONE
|
|
|
|
!
|
|
|
|
! ... local variables (ESSL version)
|
|
|
|
!
|
2006-02-04 04:20:55 +08:00
|
|
|
INTEGER :: naux, i, j, ij
|
2005-08-28 22:09:42 +08:00
|
|
|
COMPLEX(DP), ALLOCATABLE :: hp(:), aux(:)
|
2004-01-20 20:26:22 +08:00
|
|
|
!
|
|
|
|
!
|
|
|
|
naux = 4 * n
|
|
|
|
!
|
|
|
|
ALLOCATE( hp( n * (n + 1) / 2 ) )
|
2006-02-04 04:20:55 +08:00
|
|
|
ALLOCATE( aux( naux ) )
|
2004-01-20 20:26:22 +08:00
|
|
|
!
|
|
|
|
! ... copy to upper triangular packed matrix
|
|
|
|
!
|
|
|
|
ij = 0
|
|
|
|
DO j = 1, n
|
|
|
|
DO i = 1, j
|
|
|
|
ij = ij + 1
|
|
|
|
hp(ij) = h(i,j)
|
|
|
|
END DO
|
|
|
|
END DO
|
|
|
|
!
|
|
|
|
! ... only the first processor diagonalize the matrix
|
|
|
|
!
|
2004-03-24 17:36:50 +08:00
|
|
|
IF ( me_pool == root_pool ) THEN
|
2004-03-08 01:18:22 +08:00
|
|
|
!
|
2004-01-20 20:26:22 +08:00
|
|
|
CALL ZHPEV( 21, hp, e, v, ldh, n, aux, naux )
|
|
|
|
!
|
|
|
|
END IF
|
|
|
|
!
|
2004-03-25 00:30:44 +08:00
|
|
|
CALL mp_bcast( e, root_pool, intra_pool_comm )
|
|
|
|
CALL mp_bcast( v, root_pool, intra_pool_comm )
|
2004-03-08 01:18:22 +08:00
|
|
|
!
|
2004-01-20 20:26:22 +08:00
|
|
|
DEALLOCATE( aux )
|
|
|
|
DEALLOCATE( hp )
|
|
|
|
!
|
|
|
|
RETURN
|
|
|
|
!
|
|
|
|
END SUBROUTINE cdiagh_aix
|
|
|
|
!
|
|
|
|
#else
|
|
|
|
!
|
|
|
|
!-----------------------------------------------------------------------
|
2004-03-15 18:07:07 +08:00
|
|
|
SUBROUTINE cdiagh_lapack( v )
|
2004-01-20 20:26:22 +08:00
|
|
|
!-----------------------------------------------------------------------
|
|
|
|
!
|
|
|
|
IMPLICIT NONE
|
2006-02-04 04:20:55 +08:00
|
|
|
!
|
2005-08-28 22:09:42 +08:00
|
|
|
COMPLEX(DP) :: v(ldh,n)
|
2004-01-20 20:26:22 +08:00
|
|
|
!
|
|
|
|
! ... local variables (LAPACK version)
|
|
|
|
!
|
2006-02-04 04:20:55 +08:00
|
|
|
INTEGER :: lwork, nb, info
|
2005-08-28 22:09:42 +08:00
|
|
|
REAL(DP), ALLOCATABLE :: rwork(:)
|
|
|
|
COMPLEX(DP), ALLOCATABLE :: work(:)
|
2004-01-20 20:26:22 +08:00
|
|
|
!
|
2006-02-04 04:20:55 +08:00
|
|
|
INTEGER, EXTERNAL :: ILAENV
|
|
|
|
! ILAENV returns optimal block size "nb"
|
2004-01-20 20:26:22 +08:00
|
|
|
!
|
|
|
|
! ... check for the block size
|
|
|
|
!
|
|
|
|
nb = ILAENV( 1, 'ZHETRD', 'U', n, - 1, - 1, - 1 )
|
|
|
|
!
|
|
|
|
IF ( nb < 1 ) nb = MAX( 1, n )
|
|
|
|
!
|
|
|
|
IF ( nb == 1 .OR. nb >= n ) THEN
|
|
|
|
!
|
|
|
|
lwork = 2 * n - 1
|
|
|
|
!
|
|
|
|
ELSE
|
|
|
|
!
|
|
|
|
lwork = ( nb + 1 ) * n
|
|
|
|
!
|
|
|
|
END IF
|
2004-03-08 01:18:22 +08:00
|
|
|
!
|
2006-01-27 00:42:14 +08:00
|
|
|
! ... only the first processor diagonalize the matrix
|
2004-01-20 20:26:22 +08:00
|
|
|
!
|
2004-03-24 17:36:50 +08:00
|
|
|
IF ( me_pool == root_pool ) THEN
|
2004-01-20 20:26:22 +08:00
|
|
|
!
|
|
|
|
! ... allocate workspace
|
|
|
|
!
|
2004-03-08 01:18:22 +08:00
|
|
|
v = h
|
2004-01-20 20:26:22 +08:00
|
|
|
!
|
|
|
|
ALLOCATE( work( lwork ) )
|
|
|
|
ALLOCATE( rwork( 3 * n - 2 ) )
|
|
|
|
!
|
|
|
|
CALL ZHEEV( 'V', 'U', n, v, ldh, e, work, lwork, rwork, info )
|
|
|
|
!
|
|
|
|
CALL errore( 'cdiagh', 'info =/= 0', ABS( info ) )
|
|
|
|
!
|
|
|
|
! ... deallocate workspace
|
|
|
|
!
|
|
|
|
DEALLOCATE( rwork )
|
|
|
|
DEALLOCATE( work )
|
|
|
|
!
|
|
|
|
END IF
|
|
|
|
!
|
2004-03-25 00:30:44 +08:00
|
|
|
CALL mp_bcast( e, root_pool, intra_pool_comm )
|
|
|
|
CALL mp_bcast( v, root_pool, intra_pool_comm )
|
2004-03-08 01:18:22 +08:00
|
|
|
!
|
2004-01-20 20:26:22 +08:00
|
|
|
RETURN
|
|
|
|
!
|
|
|
|
END SUBROUTINE cdiagh_lapack
|
|
|
|
!
|
2003-01-20 05:58:50 +08:00
|
|
|
#endif
|
2004-01-20 20:26:22 +08:00
|
|
|
!
|
|
|
|
END SUBROUTINE cdiagh
|