- bugs fix!

This commit is contained in:
carcava 2020-01-07 00:07:41 +01:00
parent f5926bae2f
commit ab74e47548
7 changed files with 52 additions and 18 deletions

View File

@ -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

View File

@ -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 )

View File

@ -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 )

View File

@ -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

View File

@ -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 )

View File

@ -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' )
!

View File

@ -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