mirror of https://gitlab.com/QEF/q-e.git
154 lines
4.4 KiB
Fortran
154 lines
4.4 KiB
Fortran
!
|
|
! Copyright (C) 2001-2013 Quantum ESPRESSO group
|
|
! 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 .
|
|
!
|
|
!
|
|
!----------------------------------------------------------------------------
|
|
SUBROUTINE o_rinitcgg( npwx, npw, nstart, numwp, psi, o_evc, e, numv, v_states,hdiag,ptype,fcw_number,fcw_state,fcw_mat,ethr)
|
|
!----------------------------------------------------------------------------
|
|
!
|
|
! ... Operator O diagonalization in the subspace spanned
|
|
! ... by nstart states psi (atomic or random wavefunctions).
|
|
! ... Produces on output numwp eigenvectors (numwp <= nstart) in o_evc.
|
|
! ... Minimal memory use - o_evc and psi may overlap
|
|
! ... Calls o_1psi to calculate O|psi>
|
|
!
|
|
USE kinds, ONLY : DP
|
|
USE gvect, ONLY : gstart
|
|
USE io_global, ONLY : stdout
|
|
USE mp, ONLY : mp_sum
|
|
USE mp_world, ONLY : world_comm
|
|
USE fft_base, ONLY : dffts
|
|
USE mp_bands, ONLY : me_bgrp, root_bgrp, intra_bgrp_comm
|
|
!
|
|
IMPLICIT NONE
|
|
!
|
|
include 'laxlib.fh'
|
|
!
|
|
INTEGER :: npw, npwx, nstart, numwp
|
|
! dimension of the matrix to be diagonalized
|
|
! leading dimension of matrix psi, as declared in the calling pgm unit
|
|
! input number of states
|
|
! output number of states
|
|
COMPLEX (DP) :: psi(npwx,nstart), o_evc(npwx,numwp)
|
|
! input and output eigenvectors (may overlap)
|
|
REAL(DP) :: e(numwp)
|
|
|
|
INTEGER, INTENT(in) :: numv!number of valence states
|
|
REAL(kind=DP), INTENT(in) :: v_states(dffts%nnr,numv) !valence states in real space
|
|
REAL(kind=DP), INTENT(in) :: hdiag(npw)!inverse of estimation of diagonal part of hamiltonian
|
|
INTEGER, INTENT(in) :: ptype!type of approximation for O operator
|
|
INTEGER, INTENT(in) :: fcw_number!number of "fake conduction" states for O matrix method
|
|
COMPLEX(kind=DP) :: fcw_state(npw,fcw_number)! "fake conduction" states for O matrix method
|
|
REAL(kind=DP) :: fcw_mat(fcw_number,fcw_number)! "fake conduction" matrix
|
|
REAL(kind=DP), INTENT(in) :: ethr!threshold for o_1psi_gamma
|
|
|
|
|
|
! eigenvalues
|
|
!
|
|
!... local variables
|
|
!
|
|
INTEGER :: m, i, j, npw2, npwx2
|
|
REAL (DP) :: rtmp(2)
|
|
COMPLEX (DP), ALLOCATABLE :: aux(:,:)
|
|
COMPLEX (DP), ALLOCATABLE :: ctmp(:)
|
|
REAL (DP), ALLOCATABLE :: hr(:,:,:), sr(:,:)
|
|
REAL (DP), ALLOCATABLE :: en(:)
|
|
!
|
|
!
|
|
CALL start_clock( 'wfcrot1' )
|
|
!
|
|
npw2 = 2 * npw
|
|
npwx2 = 2 * npwx
|
|
!
|
|
ALLOCATE( aux( npwx, 2 ) )
|
|
ALLOCATE( ctmp( numwp ) )
|
|
ALLOCATE( hr( nstart, nstart, 2 ) )
|
|
ALLOCATE( sr( nstart, nstart ) )
|
|
ALLOCATE( en( nstart ) )
|
|
!
|
|
! ... Set up the Hamiltonian and Overlap matrix
|
|
!
|
|
DO m = 1, nstart
|
|
!
|
|
!CALL hs_1psi( npwx, npw, psi(1,m), aux(1,1), aux(1,2) )
|
|
|
|
write(stdout,*) 'Call o_1psi_gamma',m,nstart
|
|
FLUSH(stdout)
|
|
call o_1psi_gamma( numv, v_states, psi(1,m), aux(1,1),.false.,hdiag,ptype,fcw_number,fcw_state,fcw_mat,ethr)
|
|
write(stdout,*) 'Done'
|
|
FLUSH(stdout)
|
|
|
|
!call o_1psi_gamma_real( numv, v_states, psi(1,m), aux(1,1))
|
|
aux(:,2)=psi(:,m)
|
|
|
|
!
|
|
CALL DGEMV( 'T', npw2, 2, 2.D0, aux, npwx2, psi(1,m), 1, 0.D0, rtmp, 1 )
|
|
!
|
|
IF ( gstart == 2 ) rtmp(:) = rtmp(:) - psi(1,m) * aux(1,:)
|
|
!
|
|
hr(m,m,1) = rtmp(1)
|
|
sr(m,m) = rtmp(2)
|
|
!
|
|
DO j = m + 1, nstart
|
|
!
|
|
CALL DGEMV( 'T', npw2, 2, 2.D0, aux, npwx2, psi(1,j), 1, 0.D0, rtmp, 1 )
|
|
!
|
|
IF ( gstart == 2 ) rtmp(:) = rtmp(:) - psi(1,j) * aux(1,:)
|
|
!
|
|
hr(j,m,1) = rtmp(1)
|
|
sr(j,m) = rtmp(2)
|
|
!
|
|
hr(m,j,1) = rtmp(1)
|
|
sr(m,j) = rtmp(2)
|
|
!
|
|
END DO
|
|
!
|
|
END DO
|
|
!
|
|
!CALL reduce( nstart * nstart, hr(1,1,1) )
|
|
call mp_sum(hr(:,:,1),world_comm)
|
|
!CALL reduce( nstart * nstart, sr(1,1) )
|
|
CALL mp_sum(sr(:,:),world_comm)
|
|
!
|
|
! ... diagonalize
|
|
!
|
|
write(stdout,*) 'Call rdiaghg'
|
|
FLUSH(stdout)
|
|
|
|
CALL diaghg( nstart, numwp, hr(:,:,1), sr, nstart, en, hr(:,:,2), me_bgrp, root_bgrp, intra_bgrp_comm )
|
|
write(stdout,*) 'Done'
|
|
FLUSH(stdout)
|
|
|
|
!
|
|
e(1:numwp) = en(1:numwp)
|
|
!
|
|
! ... update the basis set
|
|
!
|
|
DO i = 1, npw
|
|
!
|
|
DO m = 1, numwp
|
|
!
|
|
ctmp(m) = SUM( hr(:,m,2) * psi(i,:) )
|
|
!
|
|
END DO
|
|
!
|
|
o_evc(i,1:numwp) = ctmp(1:numwp)
|
|
!
|
|
END DO
|
|
!
|
|
DEALLOCATE( en )
|
|
DEALLOCATE( sr )
|
|
DEALLOCATE( hr )
|
|
DEALLOCATE( ctmp )
|
|
DEALLOCATE( aux )
|
|
!
|
|
CALL stop_clock( 'wfcrot1' )
|
|
!
|
|
RETURN
|
|
!
|
|
END SUBROUTINE o_rinitcgg
|