mirror of https://gitlab.com/QEF/q-e.git
- bugs fix!
This commit is contained in:
parent
f5926bae2f
commit
ab74e47548
|
@ -919,12 +919,13 @@
|
|||
END INTERFACE
|
||||
|
||||
INTERFACE nlsm1
|
||||
SUBROUTINE nlsm1_x ( n, nspmn, nspmx, eigr, c, becp )
|
||||
SUBROUTINE nlsm1_x ( n, nspmn, nspmx, eigr, c, becp, pptype_ )
|
||||
USE kinds, ONLY : DP
|
||||
IMPLICIT NONE
|
||||
INTEGER, INTENT(IN) :: n, nspmn, nspmx
|
||||
COMPLEX(DP), INTENT(IN) :: eigr( :, : ), c( :, : )
|
||||
REAL(DP), INTENT(OUT) :: becp( :, : )
|
||||
INTEGER, INTENT(IN), OPTIONAL :: pptype_
|
||||
END SUBROUTINE nlsm1_x
|
||||
END INTERFACE
|
||||
|
||||
|
@ -939,12 +940,13 @@
|
|||
END INTERFACE
|
||||
|
||||
INTERFACE calbec_bgrp
|
||||
SUBROUTINE calbec_bgrp_x ( nspmn, nspmx, eigr, c_bgrp, bec_bgrp )
|
||||
SUBROUTINE calbec_bgrp_x ( nspmn, nspmx, eigr, c_bgrp, bec_bgrp, pptype_ )
|
||||
USE kinds, ONLY : DP
|
||||
IMPLICIT NONE
|
||||
INTEGER, INTENT(IN) :: nspmn, nspmx
|
||||
COMPLEX(DP), INTENT(IN) :: eigr( :, : ), c_bgrp( :, : )
|
||||
REAL(DP), INTENT(OUT) :: bec_bgrp( :, : )
|
||||
INTEGER, INTENT(IN), OPTIONAL :: pptype_
|
||||
END SUBROUTINE calbec_bgrp_x
|
||||
END INTERFACE
|
||||
|
||||
|
@ -969,12 +971,13 @@
|
|||
END INTERFACE
|
||||
|
||||
INTERFACE calbec
|
||||
SUBROUTINE calbec_x( nspmn, nspmx, eigr, c, bec )
|
||||
SUBROUTINE calbec_x( nspmn, nspmx, eigr, c, bec, pptype_ )
|
||||
USE kinds, ONLY: DP
|
||||
IMPLICIT NONE
|
||||
INTEGER, INTENT(IN) :: nspmn, nspmx
|
||||
REAL(DP), INTENT(OUT) :: bec( :, : )
|
||||
COMPLEX(DP), INTENT(IN) :: c( :, : ), eigr( :, : )
|
||||
INTEGER, INTENT(IN), OPTIONAL :: pptype_
|
||||
END SUBROUTINE calbec_x
|
||||
END INTERFACE
|
||||
|
||||
|
|
|
@ -1578,7 +1578,7 @@ END SUBROUTINE print_lambda_x
|
|||
! < beta | phi > is real. only the i lowest:
|
||||
!
|
||||
|
||||
CALL nlsm1( nbspx_bgrp, 1, nsp, eigr, cp, becp )
|
||||
CALL nlsm1( nbspx_bgrp, 1, nsp, eigr, cp, becp, 2 )
|
||||
|
||||
nnn = MIN( 12, n )
|
||||
|
||||
|
|
|
@ -577,7 +577,7 @@ SUBROUTINE cprmain( tau_out, fion_out, etot_out )
|
|||
lambda(:,:, 2) = lambda(:,:, 1)
|
||||
ENDIF
|
||||
!
|
||||
CALL calbec_bgrp( nvb+1, nsp, eigr, cm_bgrp, bec_bgrp )
|
||||
CALL calbec_bgrp( 1, nsp, eigr, cm_bgrp, bec_bgrp, 1 )
|
||||
!
|
||||
IF ( tpre ) THEN
|
||||
CALL caldbec_bgrp( eigr, cm_bgrp, dbec, descla )
|
||||
|
|
|
@ -15,7 +15,7 @@
|
|||
use kinds, only : DP
|
||||
use io_global, only : stdout
|
||||
use constants, only : autoev
|
||||
use dspev_module, only : dspev_drv, pdspev_drv, pdsyevd_drv
|
||||
use dspev_module, only : dspev_drv, pdspev_drv
|
||||
USE sic_module, only : self_interaction
|
||||
USE descriptors, ONLY : la_descriptor
|
||||
USE mp, only : mp_sum, mp_bcast
|
||||
|
|
|
@ -276,7 +276,7 @@ SUBROUTINE from_scratch( )
|
|||
ENDIF
|
||||
!
|
||||
!
|
||||
CALL calbec_bgrp ( nvb+1, nsp, eigr, c0_bgrp, bec_bgrp )
|
||||
CALL calbec_bgrp ( 1, nsp, eigr, c0_bgrp, bec_bgrp, 1 )
|
||||
!
|
||||
if ( tstress ) CALL caldbec_bgrp( eigr, cm_bgrp, dbec, descla )
|
||||
|
||||
|
|
|
@ -7,7 +7,7 @@
|
|||
!
|
||||
!
|
||||
!-----------------------------------------------------------------------
|
||||
subroutine nlsm1_x ( n, nspmn, nspmx, eigr, c, becp )
|
||||
subroutine nlsm1_x ( n, nspmn, nspmx, eigr, c, becp, pptype_ )
|
||||
!-----------------------------------------------------------------------
|
||||
|
||||
! computes: the array becp
|
||||
|
@ -35,18 +35,32 @@
|
|||
integer, intent(in) :: n, nspmn, nspmx
|
||||
complex(DP), intent(in) :: eigr( :, : ), c( :, : )
|
||||
real(DP), intent(out) :: becp( :, : )
|
||||
INTEGER, INTENT(IN), OPTIONAL :: pptype_
|
||||
! pptype_: pseudo type to process: 0 = all, 1 = norm-cons, 2 = ultra-soft
|
||||
!
|
||||
integer :: ig, is, iv, ia, l, inl
|
||||
real(DP), allocatable :: becps( :, : )
|
||||
complex(DP), allocatable :: wrk2( :, : )
|
||||
complex(DP) :: cfact
|
||||
integer :: pptype
|
||||
!
|
||||
call start_clock( 'nlsm1' )
|
||||
|
||||
IF( PRESENT( pptype_ ) ) THEN
|
||||
pptype = pptype_
|
||||
ELSE
|
||||
pptype = 0
|
||||
END IF
|
||||
|
||||
allocate( wrk2( ngw, nhm ) )
|
||||
allocate( becps( SIZE(becp,1), SIZE(becp,2) ) )
|
||||
becps = 0.0d0
|
||||
|
||||
do is = nspmn, nspmx
|
||||
!
|
||||
IF( pptype == 2 .AND. .NOT. upf(is)%tvanp ) CYCLE
|
||||
IF( pptype == 1 .AND. upf(is)%tvanp ) CYCLE
|
||||
|
||||
DO ia = 1, nat
|
||||
|
||||
IF( ityp(ia) == is ) THEN
|
||||
|
@ -83,7 +97,7 @@
|
|||
!
|
||||
inl = indv_ijkb0(ia) + 1
|
||||
IF( ngw > 0 ) THEN
|
||||
CALL dgemm( 'T', 'N', nh(is), n, 2*ngw, 1.0d0, wrk2, 2*ngw, c, 2*ngw, 0.0d0, becp( inl, 1 ), nkb )
|
||||
CALL dgemm( 'T', 'N', nh(is), n, 2*ngw, 1.0d0, wrk2, 2*ngw, c, 2*ngw, 0.0d0, becps( inl, 1 ), nkb )
|
||||
END IF
|
||||
END IF
|
||||
end do
|
||||
|
@ -91,8 +105,23 @@
|
|||
|
||||
DEALLOCATE( wrk2 )
|
||||
IF( nproc_bgrp > 1 ) THEN
|
||||
CALL mp_sum( becp, intra_bgrp_comm )
|
||||
CALL mp_sum( becps, intra_bgrp_comm )
|
||||
END IF
|
||||
do is = nspmn, nspmx
|
||||
IF( pptype == 2 .AND. .NOT. upf(is)%tvanp ) CYCLE
|
||||
IF( pptype == 1 .AND. upf(is)%tvanp ) CYCLE
|
||||
DO ia = 1, nat
|
||||
IF( ityp(ia) == is ) THEN
|
||||
inl = indv_ijkb0(ia)
|
||||
do iv = 1, nh( is )
|
||||
becp(inl+iv,:) = becps( inl+iv, : )
|
||||
end do
|
||||
END IF
|
||||
end do
|
||||
end do
|
||||
!
|
||||
|
||||
DEALLOCATE( becps )
|
||||
|
||||
call stop_clock( 'nlsm1' )
|
||||
|
||||
|
@ -144,7 +173,7 @@
|
|||
!
|
||||
do is=1,nsp
|
||||
!
|
||||
IF( upf(is)%tvanp ) THEN
|
||||
!IF( upf(is)%tvanp ) THEN
|
||||
!
|
||||
DO ia = 1, nat
|
||||
|
||||
|
@ -190,7 +219,7 @@
|
|||
END IF
|
||||
END IF
|
||||
end do
|
||||
END IF
|
||||
!END IF
|
||||
end do
|
||||
end do
|
||||
|
||||
|
@ -313,7 +342,7 @@
|
|||
|
||||
|
||||
!-----------------------------------------------------------------------
|
||||
subroutine calbec_x ( nspmn, nspmx, eigr, c, bec )
|
||||
subroutine calbec_x ( nspmn, nspmx, eigr, c, bec, pptype_ )
|
||||
!-----------------------------------------------------------------------
|
||||
|
||||
! this routine calculates array bec
|
||||
|
@ -333,12 +362,13 @@
|
|||
integer, intent(in) :: nspmn, nspmx
|
||||
real(DP), intent(out) :: bec( :, : )
|
||||
complex(DP), intent(in) :: c( :, : ), eigr( :, : )
|
||||
INTEGER, INTENT(IN), OPTIONAL :: pptype_
|
||||
|
||||
! local variables
|
||||
!
|
||||
call start_clock( 'calbec' )
|
||||
!
|
||||
call nlsm1( nbsp, nspmn, nspmx, eigr, c, bec )
|
||||
call nlsm1( nbsp, nspmn, nspmx, eigr, c, bec, pptype_ )
|
||||
!
|
||||
call stop_clock( 'calbec' )
|
||||
!
|
||||
|
@ -347,7 +377,7 @@
|
|||
!-----------------------------------------------------------------------
|
||||
|
||||
!-----------------------------------------------------------------------
|
||||
subroutine calbec_bgrp_x ( nspmn, nspmx, eigr, c_bgrp, bec_bgrp )
|
||||
subroutine calbec_bgrp_x ( nspmn, nspmx, eigr, c_bgrp, bec_bgrp, pptype_ )
|
||||
!-----------------------------------------------------------------------
|
||||
|
||||
! this routine calculates array bec
|
||||
|
@ -367,10 +397,11 @@
|
|||
integer, intent(in) :: nspmn, nspmx
|
||||
real(DP), intent(out) :: bec_bgrp( :, : )
|
||||
complex(DP), intent(in) :: c_bgrp( :, : ), eigr( :, : )
|
||||
INTEGER, INTENT(IN), OPTIONAL :: pptype_
|
||||
!
|
||||
call start_clock( 'calbec' )
|
||||
!
|
||||
call nlsm1( nbsp_bgrp, nspmn, nspmx, eigr, c_bgrp, bec_bgrp )
|
||||
call nlsm1( nbsp_bgrp, nspmn, nspmx, eigr, c_bgrp, bec_bgrp, pptype_ )
|
||||
!
|
||||
call stop_clock( 'calbec' )
|
||||
!
|
||||
|
|
|
@ -331,12 +331,12 @@
|
|||
!
|
||||
becp_bgrp = 0.0d0
|
||||
!
|
||||
CALL nlsm1 ( nbsp_bgrp, 1, nsp, eigr, phi_bgrp, becp_bgrp )
|
||||
CALL nlsm1 ( nbsp_bgrp, 1, nsp, eigr, phi_bgrp, becp_bgrp, 2 )
|
||||
CALL bec_bgrp2ortho( becp_bgrp, bephi, nrcx, descla )
|
||||
!
|
||||
becp_bgrp = 0.0d0
|
||||
!
|
||||
CALL nlsm1 ( nbsp_bgrp, 1, nsp, eigr, cp_bgrp, becp_bgrp )
|
||||
CALL nlsm1 ( nbsp_bgrp, 1, nsp, eigr, cp_bgrp, becp_bgrp, 2 )
|
||||
CALL bec_bgrp2ortho( becp_bgrp, becp_dist, nrcx, descla )
|
||||
!
|
||||
END IF
|
||||
|
|
Loading…
Reference in New Issue