scnc
/
quantum-espresso
mirror of https://gitlab.com/QEF/q-e.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Rename indv_ijkb0 to ofsbeta. 

See https://gitlab.com/QEF/q-e/-/issues/184.
This commit is contained in:
Jae-Mo Lihm 2021-04-01 18:34:34 +09:00
parent 21dcc642b5
commit 27dd382b82
49 changed files with 327 additions and 327 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
CPV/src/bforceion.f90
View File

@ -24,7 +24,7 @@ subroutine bforceion(fion,tfor,ipol,qmatinv,bec0,becdr,gqq,evalue)
use ions_base, only : nax, na, nsp, nat, ityp
use uspp_param, only: upf, nh, nhm
use uspp, only : nkb, indv_ijkb0
use uspp, only : nkb, ofsbeta
use kinds, only : dp
use constants, only :
use cell_base, only: at, alat
@ -61,8 +61,8 @@ subroutine bforceion(fion,tfor,ipol,qmatinv,bec0,becdr,gqq,evalue)
IF(upf(is)%tvanp) THEN
do iv= 1,nh(is)
do jv=1,nh(is)
inl = indv_ijkb0(ia) + iv
jnl = indv_ijkb0(ia) + jv
inl = ofsbeta(ia) + iv
jnl = ofsbeta(ia) + jv
temp=(0.d0,0.d0)
temp1=(0.d0,0.d0)
temp2=(0.d0,0.d0)

10
CPV/src/cg_sub.f90
View File

@ -39,7 +39,7 @@
USE io_files, ONLY : tmp_dir, prefix
use uspp, only : nkb, nkbus, &
betae => vkb, rhovan => becsum, &
deeq, qq_nt, nlcc_any, indv_ijkb0
deeq, qq_nt, nlcc_any, ofsbeta
use uspp_param, only : nh, upf
use cg_module, only : ene_ok, maxiter,niter_cg_restart, &
conv_thr, passop, enever, itercg,c0old
@ -391,8 +391,8 @@
IF(upf(is)%tvanp) THEN
do iv=1,nh(is)
do jv=1,nh(is)
inl = indv_ijkb0(ia) + iv
jnl = indv_ijkb0(ia) + jv
inl = ofsbeta(ia) + iv
jnl = ofsbeta(ia) + jv
gamma=gamma+ qq_nt(iv,jv,is)*becm(inl,i)*bec0(jnl,i)
end do
end do
@ -452,8 +452,8 @@
IF( upf(is)%tvanp ) THEN
do iv=1,nh(is)
do jv=1,nh(is)
inl = indv_ijkb0(ia) + iv
jnl = indv_ijkb0(ia) + jv
inl = ofsbeta(ia) + iv
jnl = ofsbeta(ia) + jv
gamma=gamma+ qq_nt(iv,jv,is)*becm(inl,i+istart-1)*bec0(jnl,jj+istart-1)*fmat_(j,i)
end do
end do

28
CPV/src/cglib.f90
View File

@ -90,7 +90,7 @@
use kinds, only: dp
use electrons_base, only: nudx, nspin, nupdwn, iupdwn, nx => nbspx, n => nbsp
use uspp_param, only: nh, upf
use uspp, only :nkb, nkbus, qq_nt, indv_ijkb0
use uspp, only :nkb, nkbus, qq_nt, ofsbeta
use gvecw, only: ngw
use ions_base, only: nat, ityp
USE cp_main_variables, ONLY: idesc
@ -115,7 +115,7 @@
nrl = idesc( LAX_DESC_NRL, iss )
comm_rot = idesc( LAX_DESC_COMM, iss )
CALL protate ( c0, bec, c0diag, becdiag, ngw, nss, istart, z0(:,:,iss), nrl, &
ityp, nat, indv_ijkb0, nh, np_rot, me_rot, comm_rot )
ityp, nat, ofsbeta, nh, np_rot, me_rot, comm_rot )
END DO
CALL stop_clock( 'rotate' )
@ -172,7 +172,7 @@ subroutine pc2(a,beca,b,becb)
use mp, only: mp_sum
use electrons_base, only: n => nbsp, ispin, nupdwn, iupdwn, nspin
use uspp_param, only: nh, upf
use uspp, only :nkb, nkbus, indv_ijkb0
use uspp, only :nkb, nkbus, ofsbeta
use uspp, only :qq_nt
@ -227,8 +227,8 @@ subroutine pc2(a,beca,b,becb)
IF( upf(is)%tvanp ) THEN
do iv=1,nh(is)
do jv=1,nh(is)
inl = indv_ijkb0(ia) + iv
jnl = indv_ijkb0(ia) + jv
inl = ofsbeta(ia) + iv
jnl = ofsbeta(ia) + jv
qq_tmp(inl,jnl)=qq_nt(iv,jv,is)
enddo
enddo
@ -338,7 +338,7 @@ subroutine pc2(a,beca,b,becb)
use mp, only: mp_sum, mp_bcast
use electrons_base, only: n => nbsp, ispin
use uspp_param, only: nh, upf
use uspp, only :nkb,qq_nt,nkbus, indv_ijkb0
use uspp, only :nkb,qq_nt,nkbus, ofsbeta
use io_global, ONLY: ionode, ionode_id
implicit none
@ -372,8 +372,8 @@ subroutine pc2(a,beca,b,becb)
IF( upf(is)%tvanp ) THEN
do iv=1,nh(is)
do jv=1,nh(is)
inl = indv_ijkb0(ia) + iv
jnl = indv_ijkb0(ia) + jv
inl = ofsbeta(ia) + iv
jnl = ofsbeta(ia) + jv
q_matrix(inl,jnl)= qq_nt(iv,jv,is)
enddo
enddo
@ -391,8 +391,8 @@ subroutine pc2(a,beca,b,becb)
js=ityp(ja)
IF( upf(js)%tvanp ) THEN
do jv=1,nh(js)
inl = indv_ijkb0(ia) + iv
jnl = indv_ijkb0(ja) + jv
inl = ofsbeta(ia) + iv
jnl = ofsbeta(ja) + jv
sca=0.d0
if (use_ema) then
! k_minus case
@ -459,7 +459,7 @@ subroutine pc2(a,beca,b,becb)
use io_global, only: stdout
use mp_global, only: intra_bgrp_comm
use uspp_param, only: nh, upf
use uspp, only :nkb, nkbus, qq_nt, indv_ijkb0
use uspp, only :nkb, nkbus, qq_nt, ofsbeta
use electrons_base, only: n => nbsp
use gvecw, only: ngw
use constants, only: pi, fpi
@ -490,7 +490,7 @@ subroutine pc2(a,beca,b,becb)
is=ityp(ia)
IF( upf(is)%tvanp ) THEN
do iv=1,nh(is)
inl = indv_ijkb0(ia) + iv
inl = ofsbeta(ia) + iv
do i=1,n
becktmp = 0.0d0
do ig=1,ngw
@ -634,7 +634,7 @@ subroutine pc2(a,beca,b,becb)
use io_global, only: stdout
use mp_global, only: intra_bgrp_comm
use uspp_param, only: nh, upf
use uspp, only :nkb, nkbus, qq_nt, indv_ijkb0
use uspp, only :nkb, nkbus, qq_nt, ofsbeta
use electrons_base, only: n => nbsp
use gvecw, only: ngw
use constants, only: pi, fpi
@ -669,7 +669,7 @@ subroutine pc2(a,beca,b,becb)
is = ityp(ia)
IF( upf(is)%tvanp ) THEN
do iv=1,nh(is)
inl = indv_ijkb0(ia) + iv
inl = ofsbeta(ia) + iv
do i=1,n
becktmp = 0.0d0
do ig=1,ngw

4
CPV/src/cp_interfaces.f90
View File

@ -823,11 +823,11 @@
INTERFACE protate
SUBROUTINE protate_x ( c0, bec, c0rot, becrot, ngwl, nss, noff, lambda, nrl, &
ityp, nat, indv_ijkb0, nh, np_rot, me_rot, comm_rot )
ityp, nat, ofsbeta, nh, np_rot, me_rot, comm_rot )
USE kinds, ONLY: DP
IMPLICIT NONE
INTEGER, INTENT(IN) :: ngwl, nss, nrl, noff
INTEGER, INTENT(IN) :: ityp(:), nat, indv_ijkb0(:), nh(:)
INTEGER, INTENT(IN) :: ityp(:), nat, ofsbeta(:), nh(:)
INTEGER, INTENT(IN) :: np_rot, me_rot, comm_rot
COMPLEX(DP), INTENT(IN) :: c0(:,:)
COMPLEX(DP), INTENT(OUT) :: c0rot(:,:)

24
CPV/src/cplib.f90
View File

@ -900,7 +900,7 @@ subroutine nlfh_x( stress, bec_bgrp, dbec, lambda, idesc )
! contribution to the internal stress tensor due to the constraints
!
USE kinds, ONLY : DP
use uspp, ONLY : nkb, qq_nt, indv_ijkb0
use uspp, ONLY : nkb, qq_nt, ofsbeta
use uspp_param, ONLY : nh, nhm, upf
use ions_base, ONLY : nat, ityp
use electrons_base, ONLY : nbspx, nbsp, nudx, nspin, nupdwn, iupdwn, ibgrp_g2l
@ -990,7 +990,7 @@ subroutine nlfh_x( stress, bec_bgrp, dbec, lambda, idesc )
!
do iv=1,nh(is)
do jv=1,nh(is)
inl=indv_ijkb0(ia) + jv
inl=ofsbeta(ia) + jv
if(abs(qq_nt(iv,jv,is)).gt.1.e-5) then
do i = 1, nc
tmpbec(iv,i) = tmpbec(iv,i) + qq_nt(iv,jv,is) * bec( inl, i, iss )
@ -1000,7 +1000,7 @@ subroutine nlfh_x( stress, bec_bgrp, dbec, lambda, idesc )
end do
do iv=1,nh(is)
inl=indv_ijkb0(ia) + iv
inl=ofsbeta(ia) + iv
do i = 1, nr
tmpdh(i,iv) = dbec( inl, i + (iss-1)*nrcx, ii, jj )
end do
@ -1513,7 +1513,7 @@ end subroutine dylmr2_
USE ions_base, ONLY: na, nsp, nat, ityp
USE io_global, ONLY: stdout
USE gvect, ONLY: gstart
USE uspp, ONLY: nkb, qq_nt, indv_ijkb0
USE uspp, ONLY: nkb, qq_nt, ofsbeta
USE uspp_param, ONLY: nh, upf
USE mp, ONLY: mp_sum
USE mp_global, ONLY: intra_bgrp_comm, nbgrp, inter_bgrp_comm
@ -1590,8 +1590,8 @@ end subroutine dylmr2_
IF( ityp(ia) /= is ) CYCLE
DO iv=1,nh(is)
DO jv=1,nh(is)
inl = indv_ijkb0(ia) + iv
jnl = indv_ijkb0(ia) + jv
inl = ofsbeta(ia) + iv
jnl = ofsbeta(ia) + jv
rsum = rsum + qq_nt(iv,jv,is)*becp_tmp(inl)*becp(jnl,ibgrp_k)
END DO
END DO
@ -1720,7 +1720,7 @@ end subroutine dylmr2_
USE kinds, ONLY: DP
USE io_global, ONLY: stdout
USE ions_base, ONLY: na, nsp, nat, ityp
USE uspp, ONLY: nhsa=>nkb, qq_nt, indv_ijkb0
USE uspp, ONLY: nhsa=>nkb, qq_nt, ofsbeta
USE uspp_param, ONLY: nhm, nh, upf
USE electrons_base, ONLY: nspin, iupdwn, nupdwn, nbspx_bgrp, ibgrp_g2l, i2gupdwn_bgrp, nbspx, &
iupdwn_bgrp, nupdwn_bgrp
@ -1770,7 +1770,7 @@ end subroutine dylmr2_
!
!$omp parallel default(none), &
!$omp shared(nrrx,nhm,nrcx,nsp,na,nspin,nrr,nupdwn,iupdwn,idesc,nh,qq_nt,bec,becdr_bgrp,ibgrp_l2g,tmplam,fion_tmp), &
!$omp shared(upf, ityp,nat,indv_ijkb0), &
!$omp shared(upf, ityp,nat,ofsbeta), &
!$omp private(tmpdr,temp,tmpbec,is,k,ia,i,iss,nss,istart,ic,nc,jv,iv,inl,ir,nr)
IF( nrrx > 0 ) THEN
@ -1801,7 +1801,7 @@ end subroutine dylmr2_
ic = idesc( LAX_DESC_IC, iss )
nc = idesc( LAX_DESC_NC, iss )
DO jv=1,nh(is)
inl = indv_ijkb0(ia) + jv
inl = ofsbeta(ia) + jv
DO iv=1,nh(is)
IF(ABS(qq_nt(iv,jv,is)).GT.1.e-5) THEN
DO i=1,nc
@ -1814,7 +1814,7 @@ end subroutine dylmr2_
ir = idesc( LAX_DESC_IR, iss )
nr = idesc( LAX_DESC_NR, iss )
DO iv=1,nh(is)
inl = indv_ijkb0(ia) + iv
inl = ofsbeta(ia) + iv
DO i=1,nrr(iss)
tmpdr(i,iv) = becdr_bgrp( inl, ibgrp_l2g(i,iss), k )
END DO
@ -1977,7 +1977,7 @@ end subroutine dylmr2_
USE kinds, ONLY : DP
USE ions_base, ONLY : nat, ityp
USE gvecw, ONLY : ngw
USE uspp, ONLY : beta, nhtol, indv_ijkb0
USE uspp, ONLY : beta, nhtol, ofsbeta
USE uspp_param, ONLY : nh, upf
USE gvect, ONLY : gstart
!
@ -1996,7 +1996,7 @@ end subroutine dylmr2_
is=ityp(ia)
DO iv=1,nh(is)
ci=cfact( nhtol(iv,is) + 1 )
inl = indv_ijkb0(ia) + iv
inl = ofsbeta(ia) + iv
DO ig=1,ngw
betae(ig,inl)=ci*beta(ig,iv,is)*eigr(ig,ia)
END DO

6
CPV/src/dforceb.f90
View File

@ -36,7 +36,7 @@ subroutine dforceb(c0, i, betae, ipol, bec0, ctabin, gqq, gqqm, qmat, dq2, df)
use ions_base, only : nat, nax, nsp, ityp
use cell_base, only: at, alat
use uspp_param, only: nh, nhm, upf
use uspp, only : nkb, nkbus, indv_ijkb0
use uspp, only : nkb, nkbus, ofsbeta
use efield_module, ONLY : ctabin_missing_1,ctabin_missing_2,n_g_missing_m,&
& ctabin_missing_rev_1,ctabin_missing_rev_2
use mp_global, only: intra_bgrp_comm, nproc_bgrp
@ -201,8 +201,8 @@ subroutine dforceb(c0, i, betae, ipol, bec0, ctabin, gqq, gqqm, qmat, dq2, df)
IF(upf(is)%tvanp) THEN
do iv=1,nh(is) !loop on projectors
do jv=1,nh(is) !loop on projectors
inl = indv_ijkb0(ia) + iv
jnl = indv_ijkb0(ia) + jv
inl = ofsbeta(ia) + iv
jnl = ofsbeta(ia) + jv
do j=1,n !loop on states
afrc(inl)=afrc(inl)+gqq(iv,jv,ia,is)*bec0(jnl,j)*qmat(j,i)&
& -CONJG(gqq(jv,iv,ia,is))*bec0(jnl,j)*conjg(qmat(i,j))

14
CPV/src/forces.f90
View File

@ -23,7 +23,7 @@
USE parallel_include
USE kinds, ONLY: dp
USE control_flags, ONLY: iprint
USE uspp, ONLY: nhsa=>nkb, dvan, deeq, indv_ijkb0
USE uspp, ONLY: nhsa=>nkb, dvan, deeq, ofsbeta
USE uspp_param, ONLY: nhm, nh
USE constants, ONLY: pi, fpi
USE ions_base, ONLY: nsp, na, nat, ityp
@ -295,8 +295,8 @@
DO iv = 1, nh(is)
DO jv = 1, nh(is)
dv = dvan(iv,jv,is)
inl = indv_ijkb0(ia) + iv
jnl = indv_ijkb0(ia) + jv
inl = ofsbeta(ia) + iv
jnl = ofsbeta(ia) + jv
IF( i + idx - 1 /= n ) THEN
dd = deeq(iv,jv,ia,iss1) + dv
af(inl,igrp) = af(inl,igrp) - fi * dd * bec(jnl,i+idx-1)
@ -348,7 +348,7 @@
USE parallel_include
USE kinds, ONLY: dp
USE control_flags, ONLY: iprint
USE uspp, ONLY: nhsa=>nkb, dvan, deeq, indv_ijkb0
USE uspp, ONLY: nhsa=>nkb, dvan, deeq, ofsbeta
USE uspp_param, ONLY: nhm, nh
USE constants, ONLY: pi, fpi
USE ions_base, ONLY: nsp, na, nat, ityp
@ -508,7 +508,7 @@
ALLOCATE( af_d( nhsa, many_fft ), aa_d( nhsa, many_fft ) )
!
!$omp parallel do default(none), &
!$omp shared(many_fft,i,n,tens,f,nat,ityp,nh,dvan,indv_ijkb0,deeq,af,aa,bec,ispin), &
!$omp shared(many_fft,i,n,tens,f,nat,ityp,nh,dvan,ofsbeta,deeq,af,aa,bec,ispin), &
!$omp private(idx,igrp,fi,fip,ia,is,iv,jv,inl,jnl,dv,dd,iss1,iss2)
DO idx = 1, 2*many_fft , 2
@ -537,8 +537,8 @@
DO iv = 1, nh(is)
DO jv = 1, nh(is)
dv = dvan(iv,jv,is)
inl = indv_ijkb0(ia) + iv
jnl = indv_ijkb0(ia) + jv
inl = ofsbeta(ia) + iv
jnl = ofsbeta(ia) + jv
IF( i + idx - 1 /= n ) THEN
dd = deeq(iv,jv,ia,iss1) + dv
af(inl,igrp) = af(inl,igrp) - fi * dd * bec(jnl,i+idx-1)

14
CPV/src/gram.f90
View File

@ -104,7 +104,7 @@ CONTAINS
USE ions_base, ONLY: nat, ityp
USE gvecw, ONLY: ngw
USE uspp_param, ONLY: nh, upf
USE uspp, ONLY: qq_nt, indv_ijkb0
USE uspp, ONLY: qq_nt, ofsbeta
USE mp, ONLY: mp_sum
USE mp_global, ONLY: intra_bgrp_comm
USE kinds, ONLY: DP
@ -126,7 +126,7 @@ CONTAINS
IF ( MOD( ia, nproc_bgrp ) == me_bgrp ) THEN
is = ityp(ia)
IF( upf(is)%tvanp ) THEN
indv = indv_ijkb0(ia)
indv = ofsbeta(ia)
DO iv=1,nh(is)
DO jv=1,nh(is)
IF(ABS(qq_nt(iv,jv,is)).GT.1.e-5) THEN
@ -153,7 +153,7 @@ CONTAINS
! on output: bec(i) is recalculated
!
USE ions_base, ONLY: na, nat, ityp
USE uspp, ONLY: nkb, nkbus, qq_nt, indv_ijkb0
USE uspp, ONLY: nkb, nkbus, qq_nt, ofsbeta
USE uspp_param, ONLY: nh, upf
USE electrons_base, ONLY: ispin, ispin_bgrp, nbspx_bgrp, ibgrp_g2l, iupdwn, nupdwn, nbspx
USE gvecw, ONLY: ngw
@ -212,12 +212,12 @@ CONTAINS
is = ityp(ia)
IF( upf(is)%tvanp ) THEN
DO iv=1,nh(is)
inl=indv_ijkb0(ia)+iv
inl=ofsbeta(ia)+iv
bec_tmp(inl) = 2.d0 * DDOT( 2*ngw, cp_bgrp(1,ibgrp_i), 1, betae(1,inl), 1) &
- g0 * DBLE(cp_bgrp(1,ibgrp_i) * CONJG(betae(1,inl)))
END DO
ELSE
inl= indv_ijkb0(ia)
inl= ofsbeta(ia)
bec_tmp( inl + 1: inl + nh(is) ) = 0.0d0
END IF
END DO
@ -235,7 +235,7 @@ CONTAINS
!$omp parallel if( (kmax - iupdwn( iss )) > omp_get_num_threads() ) default(none), &
!$omp shared(iupdwn,iss,kmax,nproc_bgrp,me_bgrp,nbspx,i,ibgrp_g2l,nh), &
!$omp shared(indv_ijkb0,qq_nt,na,bec_tmp,bec_bgrp,csc2,nat,ityp,upf), &
!$omp shared(ofsbeta,qq_nt,na,bec_tmp,bec_bgrp,csc2,nat,ityp,upf), &
!$omp private( k, is, iv, jv, ia, inl, jnl, rsum, ibgrp_k )
!$omp do
DO k = iupdwn( iss ), kmax
@ -246,7 +246,7 @@ CONTAINS
IF ( MOD( ia-1, nproc_bgrp ) == me_bgrp ) THEN
is=ityp(ia)
IF( upf(is)%tvanp ) THEN
inl = indv_ijkb0(ia)
inl = ofsbeta(ia)
DO iv=1,nh(is)
DO jv=1,nh(is)
IF(ABS(qq_nt(iv,jv,is)).GT.1.e-5) THEN

14
CPV/src/ldaU.f90
View File

@ -14,7 +14,7 @@
!
USE kinds, ONLY: DP
USE ions_base, ONLY: nat, ityp
USE uspp, ONLY: nkb, nkbus, qq_nt, indv_ijkb0
USE uspp, ONLY: nkb, nkbus, qq_nt, ofsbeta
USE uspp_param, ONLY: nh, upf
USE gvecw, ONLY: ngw
IMPLICIT NONE
@ -39,8 +39,8 @@
DO iv=1,nh(is)
DO jv=1,nh(is)
IF(ABS(qq_nt(iv,jv,is)).GT.1.e-5) THEN
inl = indv_ijkb0(ia) + iv
jnl = indv_ijkb0(ia) + jv
inl = ofsbeta(ia) + iv
jnl = ofsbeta(ia) + jv
DO i=1,nwfc
qtemp(inl,i) = qtemp(inl,i) + qq_nt(iv,jv,is)*becwfc(jnl,i)
END DO
@ -474,7 +474,7 @@
use gvecw, only: ngw
use gvect, only: g, gstart
use electrons_base, only: n => nbsp, nx => nbspx
USE uspp, ONLY: nkb, qq_nt, indv_ijkb0
USE uspp, ONLY: nkb, qq_nt, ofsbeta
USE ldaU_cp, ONLY: Hubbard_U, Hubbard_l
USE ldaU_cp, ONLY: nwfcU
use cell_base, ONLY: tpiba
@ -548,7 +548,7 @@
allocate ( auxwfc(nwfcU,nh(alpha_s)) )
!
do iv=1,nh(alpha_s)
inl=indv_ijkb0(alpha_a) + iv
inl=ofsbeta(alpha_a) + iv
do m=1,nwfcU
auxwfc(m,iv) = becwfc(inl,m)
end do
@ -559,7 +559,7 @@
auxwfc, nwfcU, qq_nt(1,1,alpha_s), nh(alpha_s), &
0.0_DP, wfcbeta, nwfcU )
do iv=1,nh(alpha_s)
inl=indv_ijkb0(alpha_a) + iv
inl=ofsbeta(alpha_a) + iv
do m=1,nwfcU
auxwfc(m,iv) = wdb(inl,m,ipol)
end do
@ -574,7 +574,7 @@
allocate ( betapsi(nh(alpha_s),nb_s:nb_e) )
allocate ( dbetapsi(nh(alpha_s),nb_s:nb_e) )
do iv=1,nh(alpha_s)
inl=indv_ijkb0(alpha_a) + iv
inl=ofsbeta(alpha_a) + iv
do i=nb_s,nb_e
betapsi (iv,i)=bp(inl,i)
dbetapsi(iv,i)=dbp(inl,i,ipol)

40
CPV/src/nl_base.f90
View File

@ -93,7 +93,7 @@
USE mp_global, ONLY : nproc_bgrp, intra_bgrp_comm
USE ions_base, only : nat, nsp, ityp
USE gvecw, only : ngw
USE uspp, only : nkb, nhtol, beta, indv_ijkb0
USE uspp, only : nkb, nhtol, beta, ofsbeta
USE uspp_param, only : nh, upf, nhm
USE gvect, ONLY : gstart
!
@ -157,7 +157,7 @@
IF( pptype == 1 .AND. upf(is)%tvanp ) CYCLE
DO ia = 1, nat
IF( ityp(ia) == is ) THEN
inl = indv_ijkb0(ia)
inl = ofsbeta(ia)
do iv = 1, nh( is )
becp(inl+iv,:) = becps( inl+iv, : )
end do
@ -332,7 +332,7 @@
!
use kinds, only : DP
use uspp_param, only : nh, upf
use uspp, only : dvan, indv_ijkb0
use uspp, only : dvan, ofsbeta
use electrons_base, only : nbsp_bgrp, nspin, ispin_bgrp, f_bgrp, nbspx_bgrp
use ions_base, only : nsp, nat, ityp
!
@ -353,12 +353,12 @@
ennl_t = 0.d0
!
!$omp parallel num_threads(min(4,omp_get_num_threads())) default(none) &
!$omp shared(nat,ityp,indv_ijkb0,nh,nbsp_bgrp,ispin_bgrp,f_bgrp,bec_bgrp,rhovan,dvan,nspin,ennl_t) &
!$omp shared(nat,ityp,ofsbeta,nh,nbsp_bgrp,ispin_bgrp,f_bgrp,bec_bgrp,rhovan,dvan,nspin,ennl_t) &
!$omp private(ia,is,indv,iv,inl,jv,ijv,jnl,sums,iss,i,sumt)
!$omp do reduction(+:ennl_t)
do ia = 1, nat
is = ityp(ia)
indv = indv_ijkb0(ia)
indv = ofsbeta(ia)
do iv = 1, nh(is)
inl = indv + iv
do jv = iv, nh(is)
@ -397,7 +397,7 @@
!
use kinds, only : DP
use uspp_param, only : nh
use uspp, only : indv_ijkb0
use uspp, only : ofsbeta
use electrons_base, only : ispin, f
use ions_base, only : nat, ityp
!
@ -420,8 +420,8 @@
do iv = 1, nh(is)
do jv = iv, nh(is)
ijv = (jv-1)*jv/2 + iv
inl = indv_ijkb0(ia) + iv
jnl = indv_ijkb0(ia) + jv
inl = ofsbeta(ia) + iv
jnl = ofsbeta(ia) + jv
rhovan( ijv, ia, iss ) = f(iwf) * bec(inl,iwf) * bec(jnl,iwf)
end do
end do
@ -469,7 +469,7 @@ SUBROUTINE dbeta_eigr_x( dbeigr, eigr )
!
USE kinds, ONLY : DP
use ions_base, only : nat, ityp
use uspp, only : nhtol, nkb, dbeta, indv_ijkb0
use uspp, only : nhtol, nkb, dbeta, ofsbeta
use uspp_param, only : nh, nhm
use gvect, only : gstart
use gvecw, only : ngw
@ -500,7 +500,7 @@ SUBROUTINE dbeta_eigr_x( dbeigr, eigr )
do i=1,3
do ia = 1, nat
is = ityp(ia)
inl = indv_ijkb0(ia)
inl = ofsbeta(ia)
do iv=1,nh(is)
l=nhtol(iv,is)
! q = 0 component (with weight 1.0)
@ -536,7 +536,7 @@ SUBROUTINE caldbec_bgrp_x( eigr, c_bgrp, dbec, idesc )
use mp, only : mp_sum
use mp_global, only : nproc_bgrp, intra_bgrp_comm, inter_bgrp_comm, nbgrp
use ions_base, only : nat, ityp
use uspp, only : nhtol, nkb, dbeta, indv_ijkb0
use uspp, only : nhtol, nkb, dbeta, ofsbeta
use uspp_param, only : nh, nhm
use gvect, only : gstart
use gvecw, only : ngw
@ -580,7 +580,7 @@ SUBROUTINE caldbec_bgrp_x( eigr, c_bgrp, dbec, idesc )
end if
do ia = 1, nat
is = ityp(ia)
inl = indv_ijkb0(ia)
inl = ofsbeta(ia)
do iss=1,nspin
IF( idesc( LAX_DESC_ACTIVE_NODE, iss ) > 0 ) THEN
nr = idesc( LAX_DESC_NR, iss )
@ -621,7 +621,7 @@ subroutine dennl_x( bec_bgrp, dbec, drhovan, denl, idesc )
!
USE kinds, ONLY : DP
use uspp_param, only : nh
use uspp, only : nkb, dvan, deeq, indv_ijkb0
use uspp, only : nkb, dvan, deeq, ofsbeta
use ions_base, only : nat, ityp
use cell_base, only : h
use io_global, only : stdout
@ -650,7 +650,7 @@ subroutine dennl_x( bec_bgrp, dbec, drhovan, denl, idesc )
drhovan=0.0d0
!$omp parallel default(none) &
!$omp shared(nat,ityp,indv_ijkb0,nh,nbsp_bgrp,ispin_bgrp,f_bgrp,bec_bgrp,drhovan,dvan,nspin,denl) &
!$omp shared(nat,ityp,ofsbeta,nh,nbsp_bgrp,ispin_bgrp,f_bgrp,bec_bgrp,drhovan,dvan,nspin,denl) &
!$omp shared(idesc,iupdwn,nupdwn,ibgrp_g2l,nrcx,dbec) &
!$omp private(ia,is,iv,inl,jv,ijv,jnl,dsums,iss,i,dsum,ii,ir,k,j,nr,istart,nss,ibgrp)
!$omp do reduction(+:denl)
@ -659,8 +659,8 @@ subroutine dennl_x( bec_bgrp, dbec, drhovan, denl, idesc )
do iv=1,nh(is)
do jv=iv,nh(is)
ijv = (jv-1)*jv/2 + iv
inl = indv_ijkb0(ia) + iv
jnl = indv_ijkb0(ia) + jv
inl = ofsbeta(ia) + iv
jnl = ofsbeta(ia) + jv
dsums=0.d0
do iss=1,nspin
IF( ( idesc( LAX_DESC_ACTIVE_NODE, iss ) > 0 ) .AND. &
@ -723,7 +723,7 @@ subroutine nlfq_bgrp_x( c_bgrp, betae, bec_bgrp, becdr_bgrp, fion )
! contribution to fion due to nonlocal part
!
USE kinds, ONLY : DP
use uspp, only : nkb, dvan, deeq, indv_ijkb0
use uspp, only : nkb, dvan, deeq, ofsbeta
use uspp_param, only : nhm, nh
use ions_base, only : nax, nat, ityp
use electrons_base, only : nbsp_bgrp, f_bgrp, nbspx_bgrp, ispin_bgrp
@ -766,7 +766,7 @@ subroutine nlfq_bgrp_x( c_bgrp, betae, bec_bgrp, becdr_bgrp, fion )
fion_loc = 0.0d0
!
!$omp parallel default(none), &
!$omp shared(becdr_bgrp,bec_bgrp,fion_loc,f_bgrp,deeq,dvan,nbsp_bgrp,indv_ijkb0,nh, &
!$omp shared(becdr_bgrp,bec_bgrp,fion_loc,f_bgrp,deeq,dvan,nbsp_bgrp,ofsbeta,nh, &
!$omp nat,nhm,nbspx_bgrp,ispin_bgrp,nproc_bgrp,me_bgrp,ityp), &
!$omp private(tmpbec,tmpdr,is,ia,iv,jv,k,inl,jnl,temp,i,mytid,ntids,sum_tmpdr)
@ -792,7 +792,7 @@ subroutine nlfq_bgrp_x( c_bgrp, betae, bec_bgrp, becdr_bgrp, fion )
#endif
tmpbec = 0.d0
do jv=1,nh(is)
jnl = indv_ijkb0(ia) + jv
jnl = ofsbeta(ia) + jv
do iv=1,nh(is)
do i = 1, nbsp_bgrp
temp = dvan(iv,jv,is) + deeq(jv,iv,ia,ispin_bgrp( i ) )
@ -802,7 +802,7 @@ subroutine nlfq_bgrp_x( c_bgrp, betae, bec_bgrp, becdr_bgrp, fion )
end do
do iv = 1, nh(is)
inl = indv_ijkb0(ia) + iv
inl = ofsbeta(ia) + iv
do i = 1, nbsp_bgrp
tmpdr(i,iv) = f_bgrp( i ) * becdr_bgrp( inl, i, k )
end do

8
CPV/src/ortho.f90
View File

@ -377,7 +377,7 @@ CONTAINS
!
SUBROUTINE compute_qs_times_betas( bephi, bec_row, qbephi, qbecp, idesc )
USE uspp, ONLY: nkb, qq_nt, qq_nt_d, indv_ijkb0, nkbus
USE uspp, ONLY: nkb, qq_nt, qq_nt_d, ofsbeta, nkbus
USE uspp_param, ONLY: nh, upf
USE electrons_base, ONLY: nspin, nbsp_bgrp, iupdwn_bgrp, nupdwn_bgrp, nbsp, nupdwn, iupdwn
USE ions_base, ONLY: na, nat, nsp, ityp
@ -428,7 +428,7 @@ CONTAINS
DO ia = 1, nat
is = ityp(ia)
IF( upf(is)%tvanp ) THEN
indv = indv_ijkb0(ia)
indv = ofsbeta(ia)
nhs = nh(is)
#if defined (__CUDA)
CALL DGEMMDRV('N', 'N', nhs, nc, nhs, 1.0d0, qq_nt_d(1,1,is), SIZE(qq_nt_d,1), &
@ -462,7 +462,7 @@ CONTAINS
END SUBROUTINE compute_qs_times_betas
SUBROUTINE keep_only_us(wrk)
USE uspp, ONLY: indv_ijkb0
USE uspp, ONLY: ofsbeta
USE uspp_param, ONLY: nh, upf
USE ions_base, ONLY: na, nat, nsp, ityp
#if defined (__CUDA)
@ -473,7 +473,7 @@ CONTAINS
INTEGER :: ia, is, inl, nhs, iv
DO ia = 1, nat
is = ityp(ia)
inl = indv_ijkb0(ia)
inl = ofsbeta(ia)
nhs = nh(is)
IF( .NOT. upf(is)%tvanp ) THEN
!$cuf kernel do (1)

6
CPV/src/ortho_base.f90
View File

@ -1166,7 +1166,7 @@ CONTAINS
USE io_global, ONLY: stdout
USE mp_bands, ONLY: intra_bgrp_comm, inter_bgrp_comm
USE uspp_param, ONLY: nh, upf
USE uspp, ONLY: nkb, nkbus, qq_nt, indv_ijkb0
USE uspp, ONLY: nkb, nkbus, qq_nt, ofsbeta
USE gvecw, ONLY: ngw
USE electrons_base, ONLY: nbsp_bgrp, nbsp
USE constants, ONLY: pi, fpi
@ -1207,11 +1207,11 @@ CONTAINS
qtemp (:,:) = 0.d0
!$omp parallel do default(none) &
!$omp shared(nat,ityp,upf,nh,indv_ijkb0,qq_nt,qtemp,bec_bgrp,nbsp_bgrp) &
!$omp shared(nat,ityp,upf,nh,ofsbeta,qq_nt,qtemp,bec_bgrp,nbsp_bgrp) &
!$omp private(ia,is,iv,inl,jv,jnl,qqf,i,indv)
DO ia = 1, nat
is = ityp(ia)
indv = indv_ijkb0(ia)
indv = ofsbeta(ia)
IF( upf(is)%tvanp ) THEN
DO iv=1,nh(is)
inl = indv + iv

8
CPV/src/pseudopot_sub.f90
View File

@ -69,7 +69,7 @@
nhtolm, &!
indv, &!
ijtoh, &!
indv_ijkb0 !
ofsbeta !
IMPLICIT NONE
@ -114,13 +114,13 @@
if( allocated( indv ) ) deallocate( indv )
if( allocated( nhtolm ) ) deallocate( nhtolm )
if( allocated( ijtoh ) ) deallocate( ijtoh )
if( allocated( indv_ijkb0 ) ) deallocate( indv_ijkb0 )
if( allocated( ofsbeta ) ) deallocate( ofsbeta )
!
allocate(nhtol(nhm,nsp))
allocate(indv (nhm,nsp))
allocate(nhtolm(nhm,nsp))
allocate(ijtoh(nhm,nhm,nsp))
allocate(indv_ijkb0(nat))
allocate(ofsbeta(nat))
! ------------------------------------------------------------------
! definition of indices nhtol, indv, nhtolm
@ -157,7 +157,7 @@
! atom ia in the global list of beta functions
do ia = 1,nat
IF ( ityp(ia) == is ) THEN
indv_ijkb0(ia) = ijkb0
ofsbeta(ia) = ijkb0
ijkb0 = ijkb0 + nh(is)
END IF
end do

6
CPV/src/qmatrixd.f90
View File

@ -26,7 +26,7 @@ subroutine qmatrixd(c0, bec0,ctable, gqq, qmat, detq, ipol)
use ions_base, only : nax, nsp, na, nat, ityp
use gvect, only: gstart
use uspp_param, only: nh, nhm, upf
use uspp, only : nkb, indv_ijkb0
use uspp, only : nkb, ofsbeta
use electrons_base, only: nx => nbspx, n => nbsp, ispin
use mp, only: mp_sum, mp_alltoall
use mp_global, only: intra_bgrp_comm, nproc_bgrp
@ -187,8 +187,8 @@ subroutine qmatrixd(c0, bec0,ctable, gqq, qmat, detq, ipol)
IF( upf(is)%tvanp ) THEN !loop on vanderbilt species
do iv=1,nh(is)!loop on projectors
do jv=1,nh(is)
inl = indv_ijkb0(ia) + iv
jnl = indv_ijkb0(ia) + jv
inl = ofsbeta(ia) + iv
jnl = ofsbeta(ia) + jv
sca=sca+gqq(iv,jv,ia,is)*bec0(inl,ix)*bec0(jnl,jx)
enddo
enddo

2
CPV/src/qqberry.f90
View File

@ -16,7 +16,7 @@ subroutine qqberry2( gqq,gqqm, ipol)
use kinds, only: dp
use uspp_param, only: upf, lmaxq, nbetam, nh, nhm
use uspp, only: indv, lpx, lpl, ap,nhtolm, nkbus, indv_ijkb0
use uspp, only: indv, lpx, lpl, ap,nhtolm, nkbus, ofsbeta
use atom, only: rgrid
use core
use gvecw, only: ngw

6
CPV/src/spinsq.f90
View File

@ -34,7 +34,7 @@
USE gvecw, ONLY: ngw
USE gvect, ONLY: gstart
USE cell_base, ONLY: omega
USE uspp, ONLY: nkb, nkbus, qq_nt, indv_ijkb0
USE uspp, ONLY: nkb, nkbus, qq_nt, ofsbeta
USE uspp_param, ONLY: nh, upf
USE ions_base, ONLY: na, nat, ityp
!
@ -120,8 +120,8 @@
DO iv=1,nh(is)
DO jv=1,nh(is)
IF(ABS(qq_nt(iv,jv,is)).GT.1.e-5) THEN
inl = indv_ijkb0(ia) + iv
jnl = indv_ijkb0(ia) + jv
inl = ofsbeta(ia) + iv
jnl = ofsbeta(ia) + jv
overlap(i,j) = overlap(i,j) + qq_nt(iv,jv,is)*bec(inl,i)*bec(jnl,jj)
ENDIF
END DO

6
CPV/src/wave.f90
View File

@ -151,7 +151,7 @@
!=----------------------------------------------------------------------------=!
SUBROUTINE protate_x ( c0, bec, c0rot, becrot, ngwl, nss, noff, lambda, nrl, &
ityp, nat, indv_ijkb0, nh, np_rot, me_rot, comm_rot )
ityp, nat, ofsbeta, nh, np_rot, me_rot, comm_rot )
!=----------------------------------------------------------------------------=!
! this routine rotates the wave functions using the matrix lambda
@ -182,7 +182,7 @@
! ... declare subroutine arguments
INTEGER, INTENT(IN) :: ngwl, nss, nrl, noff
INTEGER, INTENT(IN) :: ityp(:), nat, indv_ijkb0(:), nh(:)
INTEGER, INTENT(IN) :: ityp(:), nat, ofsbeta(:), nh(:)
INTEGER, INTENT(IN) :: np_rot, me_rot, comm_rot
COMPLEX(DP), INTENT(IN) :: c0(:,:)
COMPLEX(DP), INTENT(OUT) :: c0rot(:,:)
@ -233,7 +233,7 @@
do ia=1,nat
is=ityp(ia)
do jv=1,nh(is)
jnl = indv_ijkb0(ia) + jv
jnl = ofsbeta(ia) + jv
do i = 1, nss
becrot(jnl,i+noff-1) = becrot(jnl,i+noff-1)+ uu(jl, i) * bec( jnl, j+noff-1 )
end do

6
CPV/src/wf.f90
View File

@ -24,7 +24,7 @@ SUBROUTINE wf( clwf, c, bec, eigr, eigrb, taub, irb, &
USE kinds, ONLY : DP
USE constants, ONLY : pi, tpi
USE ions_base, ONLY : nsp, na, nax, nat, ityp
USE uspp, ONLY : indv_ijkb0, nkbus
USE uspp, ONLY : ofsbeta, nkbus
USE uspp_param, ONLY : upf
USE cell_base, ONLY : omega, at, alat, h, ainv
USE electrons_base, ONLY : nbspx, nbsp, nupdwn, iupdwn, nspin
@ -319,7 +319,7 @@ SUBROUTINE wf( clwf, c, bec, eigr, eigrb, taub, irb, &
is = ityp(ia)
IF( upf(is)%tvanp ) THEN
DO iv = 1, nh(is)
inl = indv_ijkb0(ia) + iv
inl = ofsbeta(ia) + iv
jv = iv
ijv=(jv-1)*jv/2 + iv
fg1 = eigrb(1:ngb,ia)*qgb(1:ngb,ijv,is)
@ -361,7 +361,7 @@ SUBROUTINE wf( clwf, c, bec, eigr, eigrb, taub, irb, &
END DO
END IF
DO jv = iv+1, nh(is)
jnl = indv_ijkb0(ia) + jv
jnl = ofsbeta(ia) + jv
ijv = (jv-1)*jv/2 + iv
fg1 = eigrb(1:ngb,ia)*qgb(1:ngb,ijv,is)
CALL fft_oned2box( qv, fg1 )

18
GWW/pw4gww/realus.f90
View File

@ -19,7 +19,7 @@
USE fft_base, ONLY : dfftp
USE gvect, ONLY : ngm, gg, g
USE lsda_mod, ONLY : lsda, nspin, current_spin, isk
USE uspp, ONLY : okvan, becsum, nkb, ijtoh, indv_ijkb0
USE uspp, ONLY : okvan, becsum, nkb, ijtoh, ofsbeta
USE uspp_param, ONLY : upf, lmaxq, nh
USE wvfct, ONLY : wg
USE control_flags, ONLY : gamma_only
@ -74,11 +74,11 @@
!
DO ih = 1, nhnt
!
ikb = indv_ijkb0(ia) + ih
ikb = ofsbeta(ia) + ih
!
DO jh = ih, nhnt
!
jkb = indv_ijkb0(ia) + jh
jkb = ofsbeta(ia) + jh
!
DO ir = 1, mbia
!
@ -117,7 +117,7 @@
USE fft_base, ONLY : dfftp
USE gvect, ONLY : ngm, gg, g
USE lsda_mod, ONLY : lsda, nspin, current_spin, isk
USE uspp, ONLY : okvan, becsum, nkb, ijtoh, indv_ijkb0
USE uspp, ONLY : okvan, becsum, nkb, ijtoh, ofsbeta
USE uspp_param, ONLY : upf, lmaxq, nh
USE wvfct, ONLY : wg
USE control_flags, ONLY : gamma_only
@ -159,10 +159,10 @@
!
DO ih = 1, nhnt
!
ikb = indv_ijkb0(ia) + ih
ikb = ofsbeta(ia) + ih
DO jh = ih, nhnt
!
jkb = indv_ijkb0(ia) + jh
jkb = ofsbeta(ia) + jh
!
DO ir = 1, mbia
!
@ -199,7 +199,7 @@
USE ions_base, ONLY : nat, ntyp => nsp, ityp
USE gvect, ONLY : ngm, gg, g
USE lsda_mod, ONLY : lsda, nspin, current_spin, isk
USE uspp, ONLY : okvan, becsum, nkb, indv_ijkb0
USE uspp, ONLY : okvan, becsum, nkb, ofsbeta
USE uspp_param, ONLY : upf, lmaxq, nh, nhm
USE wvfct, ONLY : wg
USE control_flags, ONLY : gamma_only
@ -244,10 +244,10 @@
!
DO ih = 1, nhnt
!
ikb = indv_ijkb0(ia) + ih
ikb = ofsbeta(ia) + ih
DO jh = ih, nhnt
!
jkb = indv_ijkb0(ia) + jh
jkb = ofsbeta(ia) + jh
!
sca = sca + qq_op(ih,jh,ia) * becp_iw(ikb)*becp_jw(jkb)
!

4
GWW/simple/khamiltonian.f90
View File

@ -23,7 +23,7 @@ subroutine khamiltonian
USE cell_base, ONLY : omega
USE ions_base, ONLY: nat, ntyp => nsp, ityp
USE uspp_param, ONLY: nh, nhm
USE uspp, ONLY: nkb, deeq, indv_ijkb0, deeq_nc
USE uspp, ONLY: nkb, deeq, ofsbeta, deeq_nc
USE lsda_mod, ONLY : nspin
USE becmod, ONLY : bec_type, calbec, allocate_bec_type, deallocate_bec_type
USE wvfct, ONLY : npwx
@ -193,7 +193,7 @@ subroutine khamiltonian
write(iun) npol
write(iun) ityp(1:nat)
write(iun) nh(1:ntyp)
write(iun) indv_ijkb0(1:nat)
write(iun) ofsbeta(1:nat)
write(iun) nkpoints
endif
!

8
GWW/simple_ip/diagonalization.f90
View File

@ -99,9 +99,9 @@ SUBROUTINE diagonalization(q,sh,input,eig,ik,kptns)
if ( sh%ityp(na) == nt ) then
do j=1,sh%ntot_e
do jh=1,sh%nh(nt)
jkb = sh%indv_ijkb0(na)+jh
jkb = sh%ofsbeta(na)+jh
do ih=1,sh%nh(nt)
ikb = sh%indv_ijkb0(na)+ih
ikb = sh%ofsbeta(na)+ih
!
csca_nc(ikb,1,j) = csca_nc(ikb,1,j) + &
sh%deeq_nc(ih,jh,na,1)*b_nc(jkb,1,j)+ &
@ -135,8 +135,8 @@ SUBROUTINE diagonalization(q,sh,input,eig,ik,kptns)
!
deeaux(1:sh%nh(nt),1:sh%nh(nt)) = sh%deeqc(1:sh%nh(nt),1:sh%nh(nt),na)
call ZGEMM('N','N', sh%nh(nt), sh%ntot_e, sh%nh(nt), (1.d0,0.d0), &
deeaux, sh%nh(nt), b_c(sh%indv_ijkb0(na)+1,1), sh%nkb, &
(0.d0, 0.d0), csca_mat(sh%indv_ijkb0(na)+1,1), sh%nkb )
deeaux, sh%nh(nt), b_c(sh%ofsbeta(na)+1,1), sh%nkb, &
(0.d0, 0.d0), csca_mat(sh%ofsbeta(na)+1,1), sh%nkb )
!
endif
enddo

14
GWW/simple_ip/simple_ip_objects.f90
View File

@ -45,7 +45,7 @@ MODULE simple_ip_objects
INTEGER, DIMENSION(3) :: nkpoints ! smooth k-points grid on which H(k) is calculated
INTEGER, DIMENSION(:), POINTER :: ityp ! (nat)
INTEGER, DIMENSION(:), POINTER :: nh ! (ntyp)
INTEGER, DIMENSION(:), POINTER :: indv_ijkb0 ! (nat)
INTEGER, DIMENSION(:), POINTER :: ofsbeta ! (nat)
REAL(kind=8) :: alat, nelec, omega ! lattice paramater, number of electrons, volume prim. cell
REAL(kind=8) :: bg(3,3) ! reciprocal basis vectors
REAL(kind=8) :: at(3,3) ! direct basis vectors
@ -113,7 +113,7 @@ MODULE simple_ip_objects
TYPE(shirley) :: element
nullify(element%ityp)
nullify(element%nh)
nullify(element%indv_ijkb0)
nullify(element%ofsbeta)
nullify(element%h0)
nullify(element%h1)
nullify(element%Vloc)
@ -132,8 +132,8 @@ MODULE simple_ip_objects
nullify(element%ityp)
if(associated(element%nh)) deallocate(element%nh)
nullify(element%nh)
if(associated(element%indv_ijkb0)) deallocate(element%indv_ijkb0)
nullify(element%indv_ijkb0)
if(associated(element%ofsbeta)) deallocate(element%ofsbeta)
nullify(element%ofsbeta)
if(associated(element%h0)) deallocate(element%h0)
nullify(element%h0)
if(associated(element%h1)) deallocate(element%h1)
@ -226,16 +226,16 @@ MODULE simple_ip_objects
call mp_bcast(sh%npol,ionode_id,world_comm)
allocate(sh%ityp(sh%nat), sh%nh(sh%ntyp), sh%indv_ijkb0(sh%nat))
allocate(sh%ityp(sh%nat), sh%nh(sh%ntyp), sh%ofsbeta(sh%nat))
if(ionode) then
read(iun) sh%ityp(1:sh%nat)
read(iun) sh%nh(1:sh%ntyp)
read(iun) sh%indv_ijkb0(1:sh%nat)
read(iun) sh%ofsbeta(1:sh%nat)
read(iun) sh%nkpoints
endif
call mp_bcast(sh%ityp,ionode_id,world_comm)
call mp_bcast(sh%nh,ionode_id,world_comm)
call mp_bcast(sh%indv_ijkb0,ionode_id,world_comm)
call mp_bcast(sh%ofsbeta,ionode_id,world_comm)
call mp_bcast(sh%nkpoints,ionode_id,world_comm)
nk = (sh%nkpoints(1))*(sh%nkpoints(2))*(sh%nkpoints(3))

6
LR_Modules/commutator_Vhubx_psi.f90
View File

@ -405,7 +405,7 @@ SUBROUTINE vecqqproj (npw, vec1, vec2, vec3, dpqq)
USE kinds, ONLY : DP
USE uspp_param, ONLY : nh
USE ions_base, ONLY : nat, ityp
USE uspp, ONLY : qq_nt, nkb, indv_ijkb0
USE uspp, ONLY : qq_nt, nkb, ofsbeta
USE wvfct, ONLY : npwx
USE mp, ONLY : mp_sum
USE mp_pools, ONLY : intra_pool_comm
@ -437,14 +437,14 @@ SUBROUTINE vecqqproj (npw, vec1, vec2, vec3, dpqq)
!
DO l1 = 1, nh(nt)
!
ibeta1 = indv_ijkb0(na) + l1
ibeta1 = ofsbeta(na) + l1
!
! aux1 = \sum_l2 qq_nt(l1,l2,nt) * |vec2(na,l2)>
!
aux1 = (0.d0, 0.d0)
!
DO l2 = 1, nh(nt)
ibeta2 = indv_ijkb0(na) + l2
ibeta2 = ofsbeta(na) + l2
aux1(:) = aux1(:) + qq_nt(l1,l2,nt) * vec2(:,ibeta2)
ENDDO
!

20
PHonon/PH/d2nsq_bare.f90
View File

@ -22,7 +22,7 @@ SUBROUTINE doubleprojqq (na, vec1, vec2, vec3, vec4, npw1, npw2, dpqq)
USE kinds, ONLY : DP
USE uspp_param, ONLY : nh
USE ions_base, ONLY : ityp
USE uspp, ONLY : qq_nt, indv_ijkb0
USE uspp, ONLY : qq_nt, ofsbeta
USE wvfct, ONLY : npwx, nbnd
USE mp_pools, ONLY : intra_pool_comm
USE mp, ONLY : mp_sum
@ -56,7 +56,7 @@ SUBROUTINE doubleprojqq (na, vec1, vec2, vec3, vec4, npw1, npw2, dpqq)
!
DO l1 = 1, nh(nt)
!
ibeta1 = indv_ijkb0(na) + l1
ibeta1 = ofsbeta(na) + l1
!
! Calculate: projvec1vec2(ibnd) = < vec1(ibnd) | vec2 > for each l1
!
@ -73,7 +73,7 @@ SUBROUTINE doubleprojqq (na, vec1, vec2, vec3, vec4, npw1, npw2, dpqq)
! aux1 = \sum_l2 qq_nt(l1,l2,nt) * |vec3_(na,l2)>
!
DO l2 = 1, nh(nt)
ibeta2 = indv_ijkb0(na) + l2
ibeta2 = ofsbeta(na) + l2
aux1(:) = aux1(:) + qq_nt(l1,l2,nt) * vec3(:,ibeta2)
ENDDO
!
@ -111,7 +111,7 @@ SUBROUTINE doubleprojqq2 (na, proj, vec3, vec4, npw2, dpqq)
USE kinds, ONLY : DP
USE uspp_param, ONLY : nh
USE ions_base, ONLY : ityp
USE uspp, ONLY : qq_nt, indv_ijkb0
USE uspp, ONLY : qq_nt, ofsbeta
USE wvfct, ONLY : npwx, nbnd
USE mp_pools, ONLY : intra_pool_comm
USE mp, ONLY : mp_sum
@ -143,12 +143,12 @@ SUBROUTINE doubleprojqq2 (na, proj, vec3, vec4, npw2, dpqq)
!
DO l1 = 1, nh(nt)
!
ibeta1 = indv_ijkb0(na) + l1
ibeta1 = ofsbeta(na) + l1
!
aux1 = (0.d0, 0.d0)
!
DO l2 = 1, nh(nt)
ibeta2 = indv_ijkb0(na) + l2
ibeta2 = ofsbeta(na) + l2
aux1(:) = aux1(:) + qq_nt(l1,l2,nt) * vec3(:,ibeta2)
ENDDO
!
@ -314,7 +314,7 @@ SUBROUTINE term_one (ik, icart, jcart, na, nap, nah, ihubst1, ihubst2, &
!--------------------------------------------------------------------
!
USE kinds, ONLY : DP
USE uspp, ONLY : nkb, okvan, indv_ijkb0
USE uspp, ONLY : nkb, okvan, ofsbeta
USE wvfct, ONLY : npwx, nbnd, wg
USE uspp_param, ONLY : nh
USE ions_base, ONLY : ityp
@ -445,7 +445,7 @@ SUBROUTINE term_one (ik, icart, jcart, na, nap, nah, ihubst1, ihubst2, &
!
DO l = 1, nh(nt)
!
ibeta = indv_ijkb0(na) + l
ibeta = ofsbeta(na) + l
!
! Calculate the 2nd derivative of the beta functions for
! all l states of atom na
@ -503,7 +503,7 @@ SUBROUTINE term_one_diag (ik, icart, jcart, na, nap, nah, ihubst1, ihubst2, &
!------------------------------------------------------------------------
!
USE kinds, ONLY : DP
USE uspp, ONLY : nkb, okvan, indv_ijkb0
USE uspp, ONLY : nkb, okvan, ofsbeta
USE wvfct, ONLY : npwx, nbnd, wg
USE uspp_param, ONLY : nh
USE ions_base, ONLY : ityp
@ -624,7 +624,7 @@ SUBROUTINE term_one_diag (ik, icart, jcart, na, nap, nah, ihubst1, ihubst2, &
!
DO l = 1, nh(nt)
!
ibeta = indv_ijkb0(na) + l
ibeta = ofsbeta(na) + l
!
! Calculate the 2nd derivative of the beta functions
! for all l states of atom na

18
PHonon/PH/delta_sphi.f90
View File

@ -38,7 +38,7 @@ SUBROUTINE delta_sphi (ikk, ikq, na, icart, nah, ihubst, wfcatomk_, wfcatomkpq_,
USE kinds, ONLY : DP
USE uspp_param, ONLY : nh, nhm
USE ions_base, ONLY : nat, ityp
USE uspp, ONLY : nkb, qq_nt, okvan, indv_ijkb0
USE uspp, ONLY : nkb, qq_nt, okvan, ofsbeta
USE ldaU, ONLY : nwfcU
USE wvfct, ONLY : npwx
USE mp_pools, ONLY : intra_pool_comm
@ -100,8 +100,8 @@ SUBROUTINE delta_sphi (ikk, ikq, na, icart, nah, ihubst, wfcatomk_, wfcatomkpq_,
! Scalar products in the m3 m4 sum
!
DO ih = 1, nh(nt)
sc1(ih) = ZDOTC (npw, vkb_(:,ih+indv_ijkb0(na)), 1, wfcatomk_(:,ihubst), 1)
sc2(ih) = ZDOTC (npw, dvkb_(:,ih+indv_ijkb0(na)), 1, wfcatomk_(:,ihubst), 1)
sc1(ih) = ZDOTC (npw, vkb_(:,ih+ofsbeta(na)), 1, wfcatomk_(:,ihubst), 1)
sc2(ih) = ZDOTC (npw, dvkb_(:,ih+ofsbeta(na)), 1, wfcatomk_(:,ihubst), 1)
ENDDO
!
CALL mp_sum(sc1, intra_pool_comm)
@ -123,8 +123,8 @@ SUBROUTINE delta_sphi (ikk, ikq, na, icart, nah, ihubst, wfcatomk_, wfcatomkpq_,
DO m3 = 1, nh(nt)
DO m4 = 1, nh(nt)
DO ig = 1, npwq
aux1(ig) = dvkbkpq_(ig,m3+indv_ijkb0(na)) * qq_nt(m3,m4,nt) * sc1(m4)
aux2(ig) = vkbkpq_(ig,m3+indv_ijkb0(na)) * qq_nt(m3,m4,nt) * sc2(m4)
aux1(ig) = dvkbkpq_(ig,m3+ofsbeta(na)) * qq_nt(m3,m4,nt) * sc1(m4)
aux2(ig) = vkbkpq_(ig,m3+ofsbeta(na)) * qq_nt(m3,m4,nt) * sc2(m4)
dqsphi(ig,ihubst) = dqsphi(ig,ihubst) + aux1(ig) + aux2(ig)
ENDDO
ENDDO
@ -147,8 +147,8 @@ SUBROUTINE delta_sphi (ikk, ikq, na, icart, nah, ihubst, wfcatomk_, wfcatomkpq_,
! Scalar products in the m3 m4 sum
!
DO ih = 1, nh(nt)
sc1(ih) = ZDOTC (npwq, vkbkpq_(:,ih+indv_ijkb0(na)), 1, wfcatomkpq_(:,ihubst), 1)
sc2(ih) = ZDOTC (npwq, dvkbkpq_(:,ih+indv_ijkb0(na)), 1, wfcatomkpq_(:,ihubst), 1)
sc1(ih) = ZDOTC (npwq, vkbkpq_(:,ih+ofsbeta(na)), 1, wfcatomkpq_(:,ihubst), 1)
sc2(ih) = ZDOTC (npwq, dvkbkpq_(:,ih+ofsbeta(na)), 1, wfcatomkpq_(:,ihubst), 1)
ENDDO
!
CALL mp_sum(sc1, intra_pool_comm)
@ -170,8 +170,8 @@ SUBROUTINE delta_sphi (ikk, ikq, na, icart, nah, ihubst, wfcatomk_, wfcatomkpq_,
DO m3 = 1, nh(nt)
DO m4 = 1, nh(nt)
DO ig = 1, npw
aux1(ig) = dvkb_(ig,m3+indv_ijkb0(na)) * qq_nt(m3,m4,nt) * sc1(m4)
aux2(ig) = vkb_(ig,m3+indv_ijkb0(na)) * qq_nt(m3,m4,nt) * sc2(m4)
aux1(ig) = dvkb_(ig,m3+ofsbeta(na)) * qq_nt(m3,m4,nt) * sc1(m4)
aux2(ig) = vkb_(ig,m3+ofsbeta(na)) * qq_nt(m3,m4,nt) * sc2(m4)
dmqsphi(ig,ihubst) = dmqsphi(ig,ihubst) + aux1(ig) + aux2(ig)
!
ENDDO

4
PHonon/PH/dnsq_bare.f90
View File

@ -33,7 +33,7 @@ SUBROUTINE dnsq_bare
sdwfcatomk, sdwfcatomkpq, dvkb, vkbkpq, dvkbkpq, &
dnsbare, dnsbare_all_modes, proj1, proj2, read_dns_bare
USE wvfct, ONLY : npwx, wg, nbnd
USE uspp, ONLY : vkb, nkb, indv_ijkb0
USE uspp, ONLY : vkb, nkb, ofsbeta
USE qpoint, ONLY : nksq, ikks, ikqs
USE control_lr, ONLY : lgamma
USE units_lr, ONLY : iuatwfc, iuatswfc
@ -152,7 +152,7 @@ SUBROUTINE dnsq_bare
nt = ityp(na)
DO ih = 1, nh(nt)
!
ibeta = indv_ijkb0(na) + ih
ibeta = ofsbeta(na) + ih
!
CALL dwfc (npw, igk_k(1,ikk), ikk, icart, &
vkb(:,ibeta), dvkb(:,ibeta,icart))

4
PHonon/PH/dnsq_orth.f90
View File

@ -42,7 +42,7 @@ SUBROUTINE dnsq_orth()
USE lsda_mod, ONLY : lsda, nspin, current_spin, isk
USE wavefunctions, ONLY : evc
USE eqv, ONLY : evq
USE uspp, ONLY : okvan, nkb, vkb, indv_ijkb0
USE uspp, ONLY : okvan, nkb, vkb, ofsbeta
USE control_flags, ONLY : iverbosity
USE mp, ONLY : mp_sum, mp_bcast
USE mp_pools, ONLY : intra_pool_comm, inter_pool_comm
@ -182,7 +182,7 @@ SUBROUTINE dnsq_orth()
!
DO ih = 1, nh(nt)
!
ibeta = indv_ijkb0(na) + ih
ibeta = ofsbeta(na) + ih
!
CALL dwfc (npw, igk_k(:,ikk), ikk, icart, &
vkb(:,ibeta), dvkb(:,ibeta,icart))

4
PHonon/PH/dvqhub_barepsi_us.f90
View File

@ -47,7 +47,7 @@ SUBROUTINE dvqhub_barepsi_us (ik, uact)
sdwfcatomk, sdwfcatomkpq, dvkb, vkbkpq, dvkbkpq, &
proj1, proj2, dnsbare, effU
USE wvfct, ONLY : npwx, nbnd
USE uspp, ONLY : vkb, nkb, indv_ijkb0
USE uspp, ONLY : vkb, nkb, ofsbeta
USE qpoint, ONLY : nksq, ikks, ikqs
USE control_lr, ONLY : lgamma
USE units_lr, ONLY : iuatwfc, iuatswfc
@ -133,7 +133,7 @@ SUBROUTINE dvqhub_barepsi_us (ik, uact)
nt = ityp(na)
DO ih = 1, nh(nt)
!
ibeta = indv_ijkb0(na) + ih
ibeta = ofsbeta(na) + ih
!
CALL dwfc (npw, igk_k(1,ikk), ikk, icart, &
vkb_(:,ibeta), dvkb(:,ibeta,icart))

4
PHonon/PH/dvqhub_barepsi_us2.f90
View File

@ -28,7 +28,7 @@ SUBROUTINE dvqhub_barepsi_us2 (ik, dvqhbar, dvqhbar_orth, dvqhbar_orth_lm)
sdwfcatomk, sdwfcatomkpq, dvkb, vkbkpq, dvkbkpq, &
proj1, proj2, effU
USE wvfct, ONLY : npwx, nbnd
USE uspp, ONLY : vkb, nkb, okvan, indv_ijkb0
USE uspp, ONLY : vkb, nkb, okvan, ofsbeta
USE qpoint, ONLY : nksq, ikks, ikqs
USE control_lr, ONLY : lgamma
USE units_lr, ONLY : iuatwfc, iuatswfc
@ -103,7 +103,7 @@ SUBROUTINE dvqhub_barepsi_us2 (ik, dvqhbar, dvqhbar_orth, dvqhbar_orth_lm)
nt = ityp(na)
DO ih = 1, nh(nt)
!
ibeta = indv_ijkb0(na) + ih
ibeta = ofsbeta(na) + ih
!
CALL dwfc (npw, igk_k(1,ikk), ikk, icart, &
vkb(:,ibeta), dvkb(:,ibeta,icart))

6
PHonon/PH/dynmat_hub_bare.f90
View File

@ -37,7 +37,7 @@ SUBROUTINE dynmat_hub_bare
effU, read_dns_bare, d2ns_type
USE wavefunctions, ONLY : evc
USE units_lr, ONLY : iuwfc, lrwfc, iuatwfc, iuatswfc
USE uspp, ONLY : vkb, nkb, indv_ijkb0
USE uspp, ONLY : vkb, nkb, ofsbeta
USE uspp_param, ONLY : nh
USE klist, ONLY : xk, ngk, igk_k
USE control_lr, ONLY : lgamma
@ -207,7 +207,7 @@ SUBROUTINE dynmat_hub_bare
DO na = 1, nat
nt = ityp(na)
DO ih = 1, nh(nt)
ibeta = indv_ijkb0(na) + ih
ibeta = ofsbeta(na) + ih
DO ibnd = 1, nbnd
projpb(ibnd, ibeta) = ZDOTC (npw, evc(:,ibnd), 1, vkb(:,ibeta), 1)
ENDDO
@ -257,7 +257,7 @@ SUBROUTINE dynmat_hub_bare
!
DO ih = 1, nh(nt)
!
ibeta = indv_ijkb0(ina) + ih
ibeta = ofsbeta(ina) + ih
!
CALL dwfc(npw, igk_k(:,ikk), ikk, icar, &
vkb(:,ibeta), dvkb(:,ibeta,icar))

16
PW/src/add_vuspsi.f90
View File

@ -19,7 +19,7 @@ SUBROUTINE add_vuspsi( lda, n, m, hpsi )
USE lsda_mod, ONLY: current_spin
USE control_flags, ONLY: gamma_only
USE noncollin_module
USE uspp, ONLY: vkb, nkb, deeq, deeq_nc, indv_ijkb0, using_vkb
USE uspp, ONLY: vkb, nkb, deeq, deeq_nc, ofsbeta, using_vkb
USE uspp_param, ONLY: nh, nhm
USE becmod, ONLY: bec_type, becp
USE becmod_subs_gpum, ONLY: using_becp_auto
@ -110,7 +110,7 @@ SUBROUTINE add_vuspsi( lda, n, m, hpsi )
ps(:,:) = 0.D0
!
! In becp=<vkb_i|psi_j> terms corresponding to atom na of type nt
! run from index i=indv_ijkb0(na)+1 to i=indv_ijkb0(na)+nh(nt)
! run from index i=ofsbeta(na)+1 to i=ofsbeta(na)+nh(nt)
!
DO nt = 1, ntyp
!
@ -125,8 +125,8 @@ SUBROUTINE add_vuspsi( lda, n, m, hpsi )
IF ( m_loc > 0 ) THEN
CALL DGEMM('N', 'N', nh(nt), m_loc, nh(nt), 1.0_dp, &
deeq(1,1,na,current_spin), nhm, &
becp%r(indv_ijkb0(na)+1,1), nkb, 0.0_dp, &
ps(indv_ijkb0(na)+1,1), nkb )
becp%r(ofsbeta(na)+1,1), nkb, 0.0_dp, &
ps(ofsbeta(na)+1,1), nkb )
ENDIF
!
ENDIF
@ -208,8 +208,8 @@ SUBROUTINE add_vuspsi( lda, n, m, hpsi )
deeaux(:,:) = CMPLX(deeq(1:nh(nt),1:nh(nt),na,current_spin),&
0.0_dp, KIND=dp )
CALL ZGEMM('N','N', nh(nt), m, nh(nt), (1.0_dp,0.0_dp), &
deeaux, nh(nt), becp%k(indv_ijkb0(na)+1,1), nkb, &
(0.0_dp, 0.0_dp), ps(indv_ijkb0(na)+1,1), nkb )
deeaux, nh(nt), becp%k(ofsbeta(na)+1,1), nkb, &
(0.0_dp, 0.0_dp), ps(ofsbeta(na)+1,1), nkb )
!
ENDIF
!
@ -258,11 +258,11 @@ SUBROUTINE add_vuspsi( lda, n, m, hpsi )
!
DO jh = 1, nh(nt)
!
jkb = indv_ijkb0(na) + jh
jkb = ofsbeta(na) + jh
!
DO ih = 1, nh(nt)
!
ikb = indv_ijkb0(na) + ih
ikb = ofsbeta(na) + ih
!
ps(ikb,1,ibnd) = ps(ikb,1,ibnd) + &
deeq_nc(ih,jh,na,1)*becp%nc(jkb,1,ibnd)+ &

28
PW/src/add_vuspsi_gpu.f90
View File

@ -19,7 +19,7 @@ SUBROUTINE add_vuspsi_gpu( lda, n, m, hpsi_d )
USE lsda_mod, ONLY: current_spin
USE control_flags, ONLY: gamma_only
USE noncollin_module
USE uspp, ONLY: indv_ijkb0, nkb, vkb_d, deeq_d, deeq_nc_d, using_vkb_d
USE uspp, ONLY: ofsbeta, nkb, vkb_d, deeq_d, deeq_nc_d, using_vkb_d
USE uspp_param, ONLY: nh, nhm
USE becmod_gpum, ONLY: bec_type_d, becp_d, using_becp_r_d, &
using_becp_k_d, using_becp_nc_d
@ -122,7 +122,7 @@ SUBROUTINE add_vuspsi_gpu( lda, n, m, hpsi_d )
ps_d(:,:) = 0.D0
!
! In becp=<vkb_i|psi_j> terms corresponding to atom na of type nt
! run from index i=indv_ijkb0(na)+1 to i=indv_ijkb0(na)+nh(nt)
! run from index i=ofsbeta(na)+1 to i=ofsbeta(na)+nh(nt)
!
DO nt = 1, ntyp
!
@ -137,8 +137,8 @@ SUBROUTINE add_vuspsi_gpu( lda, n, m, hpsi_d )
IF ( m_loc > 0 ) THEN
CALL DGEMM('N', 'N', nh(nt), m_loc, nh(nt), 1.0_dp, &
deeq_d(1,1,na,current_spin), nhm, &
becp_d%r_d(indv_ijkb0(na)+1,1), nkb, 0.0_dp, &
ps_d(indv_ijkb0(na)+1,1), nkb )
becp_d%r_d(ofsbeta(na)+1,1), nkb, 0.0_dp, &
ps_d(ofsbeta(na)+1,1), nkb )
END IF
!
END IF
@ -245,8 +245,8 @@ SUBROUTINE add_vuspsi_gpu( lda, n, m, hpsi_d )
END DO
!
CALL ZGEMM('N','N', nh(nt), m, nh(nt), (1.0_dp,0.0_dp), &
deeaux_d, nhm, becp_d%k_d(indv_ijkb0(na)+1,1), nkb, &
(0.0_dp, 0.0_dp), ps_d(indv_ijkb0(na)+1,1), nkb )
deeaux_d, nhm, becp_d%k_d(ofsbeta(na)+1,1), nkb, &
(0.0_dp, 0.0_dp), ps_d(ofsbeta(na)+1,1), nkb )
!
END IF
!
@ -306,22 +306,22 @@ SUBROUTINE add_vuspsi_gpu( lda, n, m, hpsi_d )
IF ( ityp(na) == nt ) THEN
!
CALL ZGEMM('N','N', nh(nt), m, nh(nt), (1.0_dp,0.0_dp), &
deeq_nc_d(1,1,na,1), nhm, becp_d%nc_d(indv_ijkb0(na)+1,1,1), 2*nkb, &
(0.0_dp, 0.0_dp), ps_d(indv_ijkb0(na)+1,1,1), 2*nkb )
deeq_nc_d(1,1,na,1), nhm, becp_d%nc_d(ofsbeta(na)+1,1,1), 2*nkb, &
(0.0_dp, 0.0_dp), ps_d(ofsbeta(na)+1,1,1), 2*nkb )
CALL ZGEMM('N','N', nh(nt), m, nh(nt), (1.0_dp,0.0_dp), &
deeq_nc_d(1,1,na,2), nhm, becp_d%nc_d(indv_ijkb0(na)+1,2,1), 2*nkb, &
(1.0_dp, 0.0_dp), ps_d(indv_ijkb0(na)+1,1,1), 2*nkb )
deeq_nc_d(1,1,na,2), nhm, becp_d%nc_d(ofsbeta(na)+1,2,1), 2*nkb, &
(1.0_dp, 0.0_dp), ps_d(ofsbeta(na)+1,1,1), 2*nkb )
CALL ZGEMM('N','N', nh(nt), m, nh(nt), (1.0_dp,0.0_dp), &
deeq_nc_d(1,1,na,3), nhm, becp_d%nc_d(indv_ijkb0(na)+1,1,1), 2*nkb, &
(0.0_dp, 0.0_dp), ps_d(indv_ijkb0(na)+1,2,1), 2*nkb )
deeq_nc_d(1,1,na,3), nhm, becp_d%nc_d(ofsbeta(na)+1,1,1), 2*nkb, &
(0.0_dp, 0.0_dp), ps_d(ofsbeta(na)+1,2,1), 2*nkb )
CALL ZGEMM('N','N', nh(nt), m, nh(nt), (1.0_dp,0.0_dp), &
deeq_nc_d(1,1,na,4), nhm, becp_d%nc_d(indv_ijkb0(na)+1,2,1), 2*nkb, &
(1.0_dp, 0.0_dp), ps_d(indv_ijkb0(na)+1,2,1), 2*nkb )
deeq_nc_d(1,1,na,4), nhm, becp_d%nc_d(ofsbeta(na)+1,2,1), 2*nkb, &
(1.0_dp, 0.0_dp), ps_d(ofsbeta(na)+1,2,1), 2*nkb )
! DO ibnd = 1, m
! !

4
PW/src/force_hub.f90
View File

@ -38,7 +38,7 @@ SUBROUTINE force_hub( forceh )
USE mp, ONLY : mp_sum
USE becmod, ONLY : bec_type, becp, calbec, allocate_bec_type, &
deallocate_bec_type
USE uspp, ONLY : nkb, vkb, indv_ijkb0, using_vkb
USE uspp, ONLY : nkb, vkb, ofsbeta, using_vkb
USE uspp_param, ONLY : nh
USE wavefunctions, ONLY : evc
USE klist, ONLY : nks, xk, ngk, igk_k
@ -155,7 +155,7 @@ SUBROUTINE force_hub( forceh )
!
DO alpha = 1, nat ! forces are calculated by displacing atom alpha ...
!
ijkb0 = indv_ijkb0(alpha) ! positions of beta functions for atom alpha
ijkb0 = ofsbeta(alpha) ! positions of beta functions for atom alpha
!
IF (lda_plus_u_kind.EQ.0) THEN
!

4
PW/src/force_hub_gpu.f90
View File

@ -38,7 +38,7 @@ SUBROUTINE force_hub_gpu( forceh )
USE mp, ONLY : mp_sum
USE becmod, ONLY : bec_type, becp, calbec, allocate_bec_type, &
deallocate_bec_type
USE uspp, ONLY : nkb, vkb, vkb_d, indv_ijkb0, using_vkb_d
USE uspp, ONLY : nkb, vkb, vkb_d, ofsbeta, using_vkb_d
USE uspp_param, ONLY : nh
USE wavefunctions, ONLY : evc
USE klist, ONLY : nks, xk, ngk, igk_k, igk_k_d
@ -176,7 +176,7 @@ SUBROUTINE force_hub_gpu( forceh )
!
DO alpha = 1, nat ! forces are calculated by displacing atom alpha ...
!
ijkb0 = indv_ijkb0(alpha) ! positions of beta functions for atom alpha
ijkb0 = ofsbeta(alpha) ! positions of beta functions for atom alpha
!
IF (lda_plus_u_kind.EQ.0) THEN
!

6
PW/src/force_us.f90
View File

@ -17,7 +17,7 @@ SUBROUTINE force_us( forcenl )
USE ions_base, ONLY : nat, ntyp => nsp, ityp
USE klist, ONLY : nks, xk, ngk, igk_k
USE gvect, ONLY : g
USE uspp, ONLY : nkb, vkb, qq_at, deeq, qq_so, deeq_nc, indv_ijkb0, &
USE uspp, ONLY : nkb, vkb, qq_at, deeq, qq_so, deeq_nc, ofsbeta, &
using_vkb
USE uspp_param, ONLY : upf, nh, nhm
USE wvfct, ONLY : nbnd, npwx, wg, et
@ -173,7 +173,7 @@ SUBROUTINE force_us( forcenl )
ALLOCATE( aux(nh(nt),becp%nbnd_loc) )
DO na = 1, nat
IF ( ityp(na) == nt ) THEN
ijkb0 = indv_ijkb0(na)
ijkb0 = ofsbeta(na)
! this is \sum_j q_{ij} <beta_j|psi>
CALL DGEMM( 'N','N', nh(nt), becp%nbnd_loc, nh(nt), &
1.0_dp, qq_at(1,1,na), nhm, becp%r(ijkb0+1,1), &
@ -240,7 +240,7 @@ SUBROUTINE force_us( forcenl )
!
DO nt = 1, ntyp
DO na = 1, nat
ijkb0 = indv_ijkb0(na)
ijkb0 = ofsbeta(na)
IF ( ityp(na) == nt ) THEN
DO ih = 1, nh(nt)
ikb = ijkb0 + ih

6
PW/src/force_us_gpu.f90
View File

@ -17,7 +17,7 @@ SUBROUTINE force_us_gpu( forcenl )
USE ions_base, ONLY : nat, ntyp => nsp, ityp
USE klist, ONLY : nks, xk, ngk, igk_k, igk_k_d
USE gvect_gpum, ONLY : g_d
USE uspp, ONLY : nkb, vkb_d, qq_at, deeq, qq_so, deeq_nc, indv_ijkb0, &
USE uspp, ONLY : nkb, vkb_d, qq_at, deeq, qq_so, deeq_nc, ofsbeta, &
using_vkb, using_vkb_d
USE uspp_param, ONLY : upf, nh, nhm
USE wvfct, ONLY : nbnd, npwx, wg, et
@ -212,7 +212,7 @@ SUBROUTINE force_us_gpu( forcenl )
DO na = 1, nat
IF ( ityp(na) == nt ) THEN
ijkb0 = indv_ijkb0(na)
ijkb0 = ofsbeta(na)
! this is \sum_j q_{ij} <beta_j|psi>
CALL DGEMM ('N','N', nh(nt), becp_d%nbnd_loc, nh(nt), &
1.0_dp, qq_at_d(1,1,na), nhm, becp_d%r_d(ijkb0+1,1),&
@ -280,7 +280,7 @@ SUBROUTINE force_us_gpu( forcenl )
!
DO nt = 1, ntyp
DO na = 1, nat
ijkb0 = indv_ijkb0(na)
ijkb0 = ofsbeta(na)
IF ( ityp(na) == nt ) THEN
DO ih = 1, nh(nt)
ikb = ijkb0 + ih

4
PW/src/new_ns.f90
View File

@ -231,7 +231,7 @@ SUBROUTINE compute_pproj( ik, q, p )
USE ions_base, ONLY : nat, ityp, ntyp => nsp
USE klist, ONLY : xk, igk_k, ngk
USE becmod, ONLY : becp
USE uspp, ONLY : nkb, vkb, indv_ijkb0, using_vkb
USE uspp, ONLY : nkb, vkb, ofsbeta, using_vkb
USE uspp_param, ONLY : nhm, nh
USE wvfct, ONLY : nbnd
USE wavefunctions, ONLY : evc
@ -284,7 +284,7 @@ SUBROUTINE compute_pproj( ik, q, p )
IF ( is_hubbard(nt) ) THEN
DO ib = 1, nbnd
DO ih = 1, nh(nt)
ikb = indv_ijkb0(na) + ih
ikb = ofsbeta(na) + ih
DO iw = 1, nwfcU
IF ( gamma_only ) THEN
p%r(iw,ib) = p%r(iw,ib) + q(iw,ih,na)*becp%r(ikb,ib)

8
PW/src/paw_exx.f90
View File

@ -35,7 +35,7 @@ MODULE paw_exx
USE uspp_param, ONLY : upf, nh
USE uspp, ONLY : nkb
USE paw_variables, ONLY : okpaw
USE uspp, ONLY : indv_ijkb0
USE uspp, ONLY : ofsbeta
USE io_global, ONLY : ionode, ionode_id
!
IMPLICIT NONE
@ -69,7 +69,7 @@ MODULE paw_exx
ATOMS_LOOP : &
DO na = 1, nat
IF (ityp(na)==np) THEN
ijkb0 = indv_ijkb0(na)
ijkb0 = ofsbeta(na)
DO uh = 1, nh(np)
ukb = ijkb0 + uh
DO oh = 1, nh(np)
@ -111,7 +111,7 @@ MODULE paw_exx
!
USE ions_base, ONLY : nat, ityp, ntyp => nsp
USE uspp_param, ONLY : nh, upf
USE uspp, ONLY : nkb, indv_ijkb0
USE uspp, ONLY : nkb, ofsbeta
USE io_global, ONLY : ionode
!
IMPLICIT NONE
@ -141,7 +141,7 @@ MODULE paw_exx
IF ( upf(np)%tpawp ) THEN
DO na = 1, nat
IF (ityp(na)==np) THEN
ijkb0 = indv_ijkb0(na)
ijkb0 = ofsbeta(na)
!
DO uh = 1, nh(np)
ukb = ijkb0 + uh

24
PW/src/realus.f90
View File

@ -1631,7 +1631,7 @@ MODULE realus
USE fft_base, ONLY : dffts
USE mp_bands, ONLY : intra_bgrp_comm
USE mp, ONLY : mp_sum
USE uspp, ONLY : indv_ijkb0
USE uspp, ONLY : ofsbeta
!
IMPLICIT NONE
!
@ -1680,7 +1680,7 @@ MODULE realus
!
mbia = maxbox_beta(ia) ; IF ( mbia == 0 ) CYCLE
!
ijkb0 = indv_ijkb0(ia)
ijkb0 = ofsbeta(ia)
!$omp parallel default(shared) private(ih,ikb,ir,bcr,bci)
!$omp do
DO ir =1, mbia
@ -1749,7 +1749,7 @@ MODULE realus
USE fft_base, ONLY : dffts
USE mp_bands, ONLY : intra_bgrp_comm
USE mp, ONLY : mp_sum
USE uspp, ONLY : indv_ijkb0
USE uspp, ONLY : ofsbeta
USE becmod_gpum, ONLY : using_becp_k
!
IMPLICIT NONE
@ -1796,7 +1796,7 @@ MODULE realus
!
mbia = maxbox_beta(ia) ; IF ( mbia == 0 ) CYCLE
!
ijkb0 = indv_ijkb0(ia)
ijkb0 = ofsbeta(ia)
!
!$omp parallel default(shared) private(ih,ikb,ir,bcr,bci)
!$omp do
@ -1847,7 +1847,7 @@ MODULE realus
USE cell_base, ONLY : omega
USE ions_base, ONLY : nat, nsp, ityp
USE uspp_param, ONLY : nh, nhm
USE uspp, ONLY : qq_at, indv_ijkb0
USE uspp, ONLY : qq_at, ofsbeta
USE becmod, ONLY : bec_type, becp
USE fft_base, ONLY : dffts
USE becmod_gpum, ONLY : using_becp_r
@ -1881,7 +1881,7 @@ MODULE realus
mbia = maxbox_beta(ia) ; IF ( mbia == 0 ) CYCLE
!print *, "mbia=",mbia
!
ijkb0 = indv_ijkb0(ia)
ijkb0 = ofsbeta(ia)
!
!$omp parallel
!$omp do
@ -1927,7 +1927,7 @@ MODULE realus
USE cell_base, ONLY : omega
USE ions_base, ONLY : nat, nsp, ityp
USE uspp_param, ONLY : nh, nhm
USE uspp, ONLY : qq_at, indv_ijkb0
USE uspp, ONLY : qq_at, ofsbeta
USE becmod, ONLY : bec_type, becp
USE fft_base, ONLY : dffts
USE becmod_gpum, ONLY : using_becp_k
@ -1964,7 +1964,7 @@ MODULE realus
mbia = maxbox_beta(ia) ; IF ( mbia == 0 ) CYCLE
!print *, "mbia=",mbia
!
ijkb0 = indv_ijkb0(ia)
ijkb0 = ofsbeta(ia)
!
!$omp parallel
!$omp do
@ -2013,7 +2013,7 @@ MODULE realus
USE ions_base, ONLY : nat, nsp, ityp
USE uspp_param, ONLY : nh, nhm
USE lsda_mod, ONLY : current_spin
USE uspp, ONLY : deeq, indv_ijkb0
USE uspp, ONLY : deeq, ofsbeta
USE becmod, ONLY : bec_type, becp
USE fft_base, ONLY : dffts
USE becmod_gpum, ONLY : using_becp_r
@ -2045,7 +2045,7 @@ MODULE realus
!
mbia = maxbox_beta(ia) ; IF ( mbia == 0 ) CYCLE
!
ijkb0 = indv_ijkb0(ia)
ijkb0 = ofsbeta(ia)
!
!$omp parallel
!$omp do
@ -2096,7 +2096,7 @@ MODULE realus
USE ions_base, ONLY : nat, nsp, ityp
USE uspp_param, ONLY : nh, nhm
USE lsda_mod, ONLY : current_spin
USE uspp, ONLY : deeq, indv_ijkb0
USE uspp, ONLY : deeq, ofsbeta
USE becmod, ONLY : bec_type, becp
USE fft_base, ONLY : dffts
USE becmod_gpum, ONLY : using_becp_k
@ -2129,7 +2129,7 @@ MODULE realus
!
mbia = maxbox_beta(ia) ; IF ( mbia == 0 ) CYCLE
ijkb0 = indv_ijkb0(ia)
ijkb0 = ofsbeta(ia)
!$omp parallel
!$omp do

18
PW/src/s_psi.f90
View File

@ -84,7 +84,7 @@ SUBROUTINE s_psi_( lda, n, m, psi, spsi )
!
USE kinds, ONLY: DP
USE becmod, ONLY: becp
USE uspp, ONLY: vkb, nkb, okvan, qq_at, qq_so, indv_ijkb0, using_vkb
USE uspp, ONLY: vkb, nkb, okvan, qq_at, qq_so, ofsbeta, using_vkb
USE spin_orb, ONLY: lspinorb
USE uspp_param, ONLY: upf, nh, nhm
USE ions_base, ONLY: nat, nsp, ityp
@ -229,7 +229,7 @@ SUBROUTINE s_psi_( lda, n, m, psi, spsi )
ps(:,:) = 0.0_DP
!
! In becp=<vkb_i|psi_j> terms corresponding to atom na of type nt
! run from index i=indv_ijkb0(na)+1 to i=indv_ijkb0(na)+nh(nt)
! run from index i=ofsbeta(na)+1 to i=ofsbeta(na)+nh(nt)
!
DO nt = 1, nsp
IF ( upf(nt)%tvanp ) THEN
@ -241,8 +241,8 @@ SUBROUTINE s_psi_( lda, n, m, psi, spsi )
!
IF ( m_loc > 0 ) THEN
CALL DGEMM('N', 'N', nh(nt), m_loc, nh(nt), 1.0_dp, &
qq_at(1,1,na), nhm, becp%r(indv_ijkb0(na)+1,1),&
nkb, 0.0_dp, ps(indv_ijkb0(na)+1,1), nkb )
qq_at(1,1,na), nhm, becp%r(ofsbeta(na)+1,1),&
nkb, 0.0_dp, ps(ofsbeta(na)+1,1), nkb )
ENDIF
ENDIF
ENDDO
@ -327,8 +327,8 @@ SUBROUTINE s_psi_( lda, n, m, psi, spsi )
IF ( ityp(na) == nt ) THEN
qqc(:,:) = CMPLX ( qq_at(1:nh(nt),1:nh(nt),na), 0.0_DP, KIND=DP )
CALL ZGEMM('N','N', nh(nt), m, nh(nt), (1.0_DP,0.0_DP), &
qqc, nh(nt), becp%k(indv_ijkb0(na)+1,1), nkb, &
(0.0_DP,0.0_DP), ps(indv_ijkb0(na)+1,1), nkb )
qqc, nh(nt), becp%k(ofsbeta(na)+1,1), nkb, &
(0.0_DP,0.0_DP), ps(ofsbeta(na)+1,1), nkb )
ENDIF
ENDDO
DEALLOCATE( qqc )
@ -338,7 +338,7 @@ SUBROUTINE s_psi_( lda, n, m, psi, spsi )
IF (nh(nt)>0) THEN
DO na = 1, nat
IF ( ityp(na) == nt ) THEN
ps(indv_ijkb0(na)+1:indv_ijkb0(na)+nh(nt),1:m) = (0.0_DP,0.0_DP)
ps(ofsbeta(na)+1:ofsbeta(na)+nh(nt),1:m) = (0.0_DP,0.0_DP)
ENDIF
ENDDO
ENDIF
@ -398,9 +398,9 @@ SUBROUTINE s_psi_( lda, n, m, psi, spsi )
DO na = 1, nat
IF ( ityp(na) == nt ) THEN
DO ih = 1, nh(nt)
ikb = indv_ijkb0(na) + ih
ikb = ofsbeta(na) + ih
DO jh = 1, nh(nt)
jkb = indv_ijkb0(na) + jh
jkb = ofsbeta(na) + jh
IF ( .NOT. lspinorb ) THEN
DO ipol = 1, npol
DO ibnd = 1, m

32
PW/src/s_psi_gpu.f90
View File

@ -97,7 +97,7 @@ SUBROUTINE s_psi__gpu( lda, n, m, psi_d, spsi_d )
#endif
USE kinds, ONLY : DP
USE becmod_gpum, ONLY : becp_d
USE uspp, ONLY : nkb, okvan, indv_ijkb0, vkb_d, using_vkb_d
USE uspp, ONLY : nkb, okvan, ofsbeta, vkb_d, using_vkb_d
USE spin_orb, ONLY : lspinorb
USE uspp_param, ONLY : upf, nh, nhm
USE ions_base, ONLY : nat, nsp, ityp
@ -266,7 +266,7 @@ SUBROUTINE s_psi__gpu( lda, n, m, psi_d, spsi_d )
ps_d(1:nkb,1:m_max) = 0.D0
!
! In becp=<vkb_i|psi_j> terms corresponding to atom na of type nt
! run from index i=indv_ijkb0(na)+1 to i=indv_ijkb0(na)+nh(nt)
! run from index i=ofsbeta(na)+1 to i=ofsbeta(na)+nh(nt)
!
DO nt = 1, nsp
IF ( upf(nt)%tvanp ) THEN
@ -278,8 +278,8 @@ SUBROUTINE s_psi__gpu( lda, n, m, psi_d, spsi_d )
!
IF ( m_loc > 0 ) THEN
CALL DGEMM('N', 'N', nh(nt), m_loc, nh(nt), 1.0_dp, &
qq_at_d(1,1,na), nhm, becp_d%r_d(indv_ijkb0(na)+1,1),&
nkb, 0.0_dp, ps_d(indv_ijkb0(na)+1,1), nkb )
qq_at_d(1,1,na), nhm, becp_d%r_d(ofsbeta(na)+1,1),&
nkb, 0.0_dp, ps_d(ofsbeta(na)+1,1), nkb )
END IF
END IF
END DO
@ -385,8 +385,8 @@ SUBROUTINE s_psi__gpu( lda, n, m, psi_d, spsi_d )
DO na = 1, nat
IF ( ityp(na) == nt ) THEN
CALL ZGEMM('N','N', nh(nt), m, nh(nt), (1.0_dp,0.0_dp), &
qqc_d(1,1,na), nhm, becp_d%k_d(indv_ijkb0(na)+1,1), nkb, &
(0.0_dp,0.0_dp), ps_d(indv_ijkb0(na)+1,1), nkb )
qqc_d(1,1,na), nhm, becp_d%k_d(ofsbeta(na)+1,1), nkb, &
(0.0_dp,0.0_dp), ps_d(ofsbeta(na)+1,1), nkb )
!
END IF
END DO
@ -469,8 +469,8 @@ SUBROUTINE s_psi__gpu( lda, n, m, psi_d, spsi_d )
IF ( ityp(na) == nt ) THEN
DO ipol=1,npol
CALL ZGEMM('N','N', nh(nt), m, nh(nt), (1.0_dp,0.0_dp), &
qqc_d(1,1, na), nhm, becp_d%nc_d(indv_ijkb0(na)+1,ipol,1), nkb*npol, &
(0.0_dp,0.0_dp), ps_d(indv_ijkb0(na)+1,ipol,1), nkb*npol )
qqc_d(1,1, na), nhm, becp_d%nc_d(ofsbeta(na)+1,ipol,1), nkb*npol, &
(0.0_dp,0.0_dp), ps_d(ofsbeta(na)+1,ipol,1), nkb*npol )
END DO
END IF
END DO
@ -478,18 +478,18 @@ SUBROUTINE s_psi__gpu( lda, n, m, psi_d, spsi_d )
DO na = 1, nat
IF ( ityp(na) == nt ) THEN
CALL ZGEMM('N','N', nh(nt), m, nh(nt), (1.0_dp,0.0_dp), &
qq_so_d(1,1,1,nt), nhm, becp_d%nc_d(indv_ijkb0(na)+1,1,1), nkb*npol, &
(0.0_dp,0.0_dp), ps_d(indv_ijkb0(na)+1,1,1), nkb*npol )
qq_so_d(1,1,1,nt), nhm, becp_d%nc_d(ofsbeta(na)+1,1,1), nkb*npol, &
(0.0_dp,0.0_dp), ps_d(ofsbeta(na)+1,1,1), nkb*npol )
CALL ZGEMM('N','N', nh(nt), m, nh(nt), (1.0_dp,0.0_dp), &
qq_so_d(1,1,2,nt), nhm, becp_d%nc_d(indv_ijkb0(na)+1,2,1), nkb*npol, &
(1.0_dp,0.0_dp), ps_d(indv_ijkb0(na)+1,1,1), nkb*npol )
qq_so_d(1,1,2,nt), nhm, becp_d%nc_d(ofsbeta(na)+1,2,1), nkb*npol, &
(1.0_dp,0.0_dp), ps_d(ofsbeta(na)+1,1,1), nkb*npol )
!
CALL ZGEMM('N','N', nh(nt), m, nh(nt), (1.0_dp,0.0_dp), &
qq_so_d(1,1,3,nt), nhm, becp_d%nc_d(indv_ijkb0(na)+1,1,1), nkb*npol, &
(0.0_dp,0.0_dp), ps_d(indv_ijkb0(na)+1,2,1), nkb*npol )
qq_so_d(1,1,3,nt), nhm, becp_d%nc_d(ofsbeta(na)+1,1,1), nkb*npol, &
(0.0_dp,0.0_dp), ps_d(ofsbeta(na)+1,2,1), nkb*npol )
CALL ZGEMM('N','N', nh(nt), m, nh(nt), (1.0_dp,0.0_dp), &
qq_so_d(1,1,4,nt), nhm, becp_d%nc_d(indv_ijkb0(na)+1,2,1), nkb*npol, &
(1.0_dp,0.0_dp), ps_d(indv_ijkb0(na)+1,2,1), nkb*npol )
qq_so_d(1,1,4,nt), nhm, becp_d%nc_d(ofsbeta(na)+1,2,1), nkb*npol, &
(1.0_dp,0.0_dp), ps_d(ofsbeta(na)+1,2,1), nkb*npol )
END IF
END DO
END IF

18
PW/src/sum_band.f90
View File

@ -923,7 +923,7 @@ SUBROUTINE sum_bec ( ik, current_spin, ibnd_start, ibnd_end, this_bgrp_nbnd )
USE becmod, ONLY : becp, calbec, allocate_bec_type
USE control_flags, ONLY : gamma_only, tqr
USE ions_base, ONLY : nat, ntyp => nsp, ityp
USE uspp, ONLY : nkb, vkb, becsum, ebecsum, indv_ijkb0, &
USE uspp, ONLY : nkb, vkb, becsum, ebecsum, ofsbeta, &
using_vkb
USE uspp_param, ONLY : upf, nh, nhm
USE wvfct, ONLY : nbnd, wg, et, current_k
@ -1017,7 +1017,7 @@ SUBROUTINE sum_bec ( ik, current_spin, ibnd_start, ibnd_end, this_bgrp_nbnd )
END IF
!
! In becp=<vkb_i|psi_j> terms corresponding to atom na of type nt
! run from index i=indv_ijkb0(na)+1 to i=indv_ijkb0(na)+nh(nt)
! run from index i=ofsbeta(na)+1 to i=ofsbeta(na)+nh(nt)
!
DO na = 1, nat
!
@ -1031,7 +1031,7 @@ SUBROUTINE sum_bec ( ik, current_spin, ibnd_start, ibnd_end, this_bgrp_nbnd )
!$omp parallel do default(shared), private(is,ih,ikb,ibnd)
DO is = 1, npol
DO ih = 1, nh(np)
ikb = indv_ijkb0(na) + ih
ikb = ofsbeta(na) + ih
DO kbnd = 1, this_bgrp_nbnd ! ibnd_start, ibnd_end
ibnd = ibnd_start + kbnd - 1
auxk1(ibnd,ih+(is-1)*nh(np))= becp%nc(ikb,is,kbnd)
@ -1050,7 +1050,7 @@ SUBROUTINE sum_bec ( ik, current_spin, ibnd_start, ibnd_end, this_bgrp_nbnd )
!
!$omp parallel do default(shared), private(ih,ikb,ibnd,ibnd_loc)
DO ih = 1, nh(np)
ikb = indv_ijkb0(na) + ih
ikb = ofsbeta(na) + ih
DO ibnd_loc = 1, nbnd_loc
ibnd = (ibnd_start - 1) + ibnd_loc + becp%ibnd_begin - 1
auxg(ibnd_loc,ih)= wg(ibnd,ik)*becp%r(ikb,ibnd_loc)
@ -1058,12 +1058,12 @@ SUBROUTINE sum_bec ( ik, current_spin, ibnd_start, ibnd_end, this_bgrp_nbnd )
END DO
!$omp end parallel do
CALL DGEMM ( 'N', 'N', nh(np), nh(np), nbnd_loc, &
1.0_dp, becp%r(indv_ijkb0(na)+1,1), nkb, &
1.0_dp, becp%r(ofsbeta(na)+1,1), nkb, &
auxg, nbnd_loc, 0.0_dp, aux_gk, nh(np) )
if (tqr) then
!$omp parallel do default(shared), private(ih,ikb,ibnd,ibnd_loc)
DO ih = 1, nh(np)
ikb = indv_ijkb0(na) + ih
ikb = ofsbeta(na) + ih
DO ibnd_loc = 1, nbnd_loc
ibnd = (ibnd_start - 1) + ibnd_loc + becp%ibnd_begin - 1
auxg(ibnd_loc,ih) = et(ibnd,ik) * auxg(ibnd_loc,ih)
@ -1071,7 +1071,7 @@ SUBROUTINE sum_bec ( ik, current_spin, ibnd_start, ibnd_end, this_bgrp_nbnd )
END DO
!$omp end parallel do
CALL DGEMM ( 'N', 'N', nh(np), nh(np), nbnd_loc, &
1.0_dp, becp%r(indv_ijkb0(na)+1,1), nkb, &
1.0_dp, becp%r(ofsbeta(na)+1,1), nkb, &
auxg, nbnd_loc, 0.0_dp, aux_egk, nh(np) )
end if
!
@ -1079,7 +1079,7 @@ SUBROUTINE sum_bec ( ik, current_spin, ibnd_start, ibnd_end, this_bgrp_nbnd )
!
!$omp parallel do default(shared), private(ih,ikb,ibnd)
DO ih = 1, nh(np)
ikb = indv_ijkb0(na) + ih
ikb = ofsbeta(na) + ih
DO kbnd = 1, this_bgrp_nbnd ! ibnd_start, ibnd_end
ibnd = ibnd_start + kbnd - 1
auxk1(ibnd,ih) = becp%k(ikb,kbnd)
@ -1097,7 +1097,7 @@ SUBROUTINE sum_bec ( ik, current_spin, ibnd_start, ibnd_end, this_bgrp_nbnd )
if (tqr) then
!$omp parallel do default(shared), private(ih,ikb,ibnd)
DO ih = 1, nh(np)
ikb = indv_ijkb0(na) + ih
ikb = ofsbeta(na) + ih
DO kbnd = 1, this_bgrp_nbnd ! ibnd_start, ibnd_end
ibnd = ibnd_start + kbnd - 1
auxk2(ibnd,ih) = et(ibnd,ik)*auxk2(ibnd,ih)

20
PW/src/sum_band_gpu.f90
View File

@ -1062,8 +1062,8 @@ SUBROUTINE sum_bec_gpu ( ik, current_spin, ibnd_start, ibnd_end, this_bgrp_nbnd
USE becmod, ONLY : becp, calbec, allocate_bec_type
USE control_flags, ONLY : gamma_only, tqr
USE ions_base, ONLY : nat, ntyp => nsp, ityp
USE uspp, ONLY : nkb, becsum, ebecsum, indv_ijkb0, &
vkb_d, becsum_d, ebecsum_d, indv_ijkb0_d, using_vkb_d
USE uspp, ONLY : nkb, becsum, ebecsum, ofsbeta, &
vkb_d, becsum_d, ebecsum_d, ofsbeta_d, using_vkb_d
USE uspp_param, ONLY : upf, nh, nhm
USE wvfct, ONLY : nbnd, wg, et, current_k
USE klist, ONLY : ngk, nkstot
@ -1164,7 +1164,7 @@ SUBROUTINE sum_bec_gpu ( ik, current_spin, ibnd_start, ibnd_end, this_bgrp_nbnd
END IF
!
! In becp=<vkb_i|psi_j> terms corresponding to atom na of type nt
! run from index i=indv_ijkb0(na)+1 to i=indv_ijkb0(na)+nh(nt)
! run from index i=ofsbeta(na)+1 to i=ofsbeta(na)+nh(nt)
!
nhnt = nh(np)
DO na = 1, nat
@ -1180,7 +1180,7 @@ SUBROUTINE sum_bec_gpu ( ik, current_spin, ibnd_start, ibnd_end, this_bgrp_nbnd
!$cuf kernel do(2)
DO is = 1, npol
DO ih = 1, nhnt
ikb = indv_ijkb0_d(na) + ih
ikb = ofsbeta_d(na) + ih
DO ibnd = ibnd_start, ibnd_end
auxk1_d(ibnd,ih+(is-1)*nhnt)= becp_d_nc_d(ikb,is,ibnd)
auxk2_d(ibnd,ih+(is-1)*nhnt)= wg_d(ibnd,ik) * &
@ -1200,7 +1200,7 @@ SUBROUTINE sum_bec_gpu ( ik, current_spin, ibnd_start, ibnd_end, this_bgrp_nbnd
!$cuf kernel do(2)
DO ih = 1, nhnt
DO ibnd_loc = 1, nbnd_loc
ikb = indv_ijkb0_d(na) + ih
ikb = ofsbeta_d(na) + ih
ibnd = ibnd_loc + ibnd_begin - 1
auxg_d(ibnd_loc,ih) = becp_d_r_d(ikb,ibnd_loc) * wg_d(ibnd,ik)
END DO
@ -1212,21 +1212,21 @@ SUBROUTINE sum_bec_gpu ( ik, current_spin, ibnd_start, ibnd_end, this_bgrp_nbnd
! summation across bgrps performed outside will gives the right value.
!
CALL cublasDgemm ( 'N', 'N', nhnt, nhnt, nbnd_loc, &
1.0_dp/nbgrp, becp_d%r_d(indv_ijkb0(na)+1,1), nkb, &
1.0_dp/nbgrp, becp_d%r_d(ofsbeta(na)+1,1), nkb, &
auxg_d, nbnd_loc, 0.0_dp, aux_gk_d, nhnt )
!
if (tqr) then
CALL using_et_d(0)
!$cuf kernel do(1)
DO ih = 1, nhnt
ikb = indv_ijkb0_d(na) + ih
ikb = ofsbeta_d(na) + ih
DO ibnd_loc = 1, nbnd_loc
auxg_d(ibnd_loc,ih) = et_d(ibnd_loc,ik) * auxg_d(ibnd_loc,ih)
END DO
END DO
CALL cublasDgemm ( 'N', 'N', nhnt, nhnt, nbnd_loc, &
1.0_dp/nbgrp, becp_d%r_d(indv_ijkb0(na)+1,1), nkb, &
1.0_dp/nbgrp, becp_d%r_d(ofsbeta(na)+1,1), nkb, &
auxg_d, nbnd_loc, 0.0_dp, aux_egk_d, nhnt )
end if
!
@ -1236,7 +1236,7 @@ SUBROUTINE sum_bec_gpu ( ik, current_spin, ibnd_start, ibnd_end, this_bgrp_nbnd
!$cuf kernel do(2) <<<*,*>>>
DO ih = 1, nhnt
DO ibnd = ibnd_start, ibnd_end
ikb = indv_ijkb0_d(na) + ih
ikb = ofsbeta_d(na) + ih
auxk1_d(ibnd,ih) = becp_d_k_d(ikb,ibnd)
auxk2_d(ibnd,ih) = wg_d(ibnd,ik)*becp_d_k_d(ikb,ibnd)
END DO
@ -1253,7 +1253,7 @@ SUBROUTINE sum_bec_gpu ( ik, current_spin, ibnd_start, ibnd_end, this_bgrp_nbnd
!$cuf kernel do(2)
DO ih = 1, nhnt
DO ibnd = ibnd_start, ibnd_end
ikb = indv_ijkb0_d(na) + ih
ikb = ofsbeta_d(na) + ih
auxk2_d(ibnd,ih) = et_d(ibnd,ik)*auxk2_d(ibnd,ih)
END DO
END DO

28
PW/src/us_exx.f90
View File

@ -176,7 +176,7 @@ MODULE us_exx
!
USE constants, ONLY : tpi
USE ions_base, ONLY : nat, ntyp => nsp, ityp, tau
USE uspp, ONLY : nkb, vkb, okvan, indv_ijkb0, ijtoh
USE uspp, ONLY : nkb, vkb, okvan, ofsbeta, ijtoh
USE uspp_param, ONLY : upf, nh, nhm, lmaxq
USE gvect, ONLY : g, eigts1, eigts2, eigts3, mill, gstart
USE control_flags, ONLY : gamma_only
@ -262,7 +262,7 @@ MODULE us_exx
!
! ijkb0 points to the manifold of beta functions for atom na
!
ijkb0 = indv_ijkb0(na)
ijkb0 = ofsbeta(na)
!
aux2(:) = (0.0_dp, 0.0_dp)
DO ih = 1, nh(nt)
@ -359,7 +359,7 @@ MODULE us_exx
!
USE constants, ONLY : tpi
USE ions_base, ONLY : nat, ntyp => nsp, ityp, tau
USE uspp, ONLY : nkb, vkb, okvan, indv_ijkb0, ijtoh
USE uspp, ONLY : nkb, vkb, okvan, ofsbeta, ijtoh
USE uspp_param, ONLY : upf, nh, nhm, lmaxq
USE gvect, ONLY : gg, g, gstart, eigts1, eigts2, eigts3, mill
USE cell_base, ONLY : omega
@ -469,7 +469,7 @@ MODULE us_exx
!
! ijkb0 points to the manifold of beta functions for atom na
!
ijkb0 = indv_ijkb0(na)
ijkb0 = ofsbeta(na)
!
aux2(1:realblocksize) = CONJG( auxvc(offset+1:offset+realblocksize) ) * eigqts(na) * &
eigts1(mill(1,offset+1:offset+realblocksize), na) * &
@ -523,7 +523,7 @@ MODULE us_exx
!! \[ H = H+\sum_I |\beta_I\rangle \alpha_{Ii} \]
!
USE ions_base, ONLY : nat, ntyp => nsp, ityp
USE uspp, ONLY : nkb, okvan,indv_ijkb0
USE uspp, ONLY : nkb, okvan,ofsbeta
USE uspp_param, ONLY : upf, nh
USE wvfct, ONLY : nbnd, npwx
USE control_flags, ONLY : gamma_only
@ -570,7 +570,7 @@ MODULE us_exx
DO na = 1, nat
IF (ityp(na)==np) THEN
DO ih = 1, nh(np)
ikb = indv_ijkb0(na) + ih
ikb = ofsbeta(na) + ih
!
IF (ABS(deexx(ikb)) < eps_occ) CYCLE
!
@ -615,7 +615,7 @@ MODULE us_exx
!
USE ions_base, ONLY : nat, ityp
USE cell_base, ONLY : omega
USE uspp, ONLY : okvan, nkb, ijtoh, indv_ijkb0
USE uspp, ONLY : okvan, nkb, ijtoh, ofsbeta
USE uspp_param, ONLY : upf, nh
USE realus, ONLY : tabxx
!
@ -647,8 +647,8 @@ MODULE us_exx
!
DO ih = 1, nh(nt)
DO jh = 1, nh(nt)
ikb = indv_ijkb0(ia) + ih
jkb = indv_ijkb0(ia) + jh
ikb = ofsbeta(ia) + ih
jkb = ofsbeta(ia) + jh
DO ir = 1, mbia
irb = tabxx(ia)%box(ir)
rho(irb) = rho(irb) + tabxx(ia)%qr(ir,ijtoh(ih,jh,nt)) &
@ -675,7 +675,7 @@ MODULE us_exx
USE cell_base, ONLY : omega
USE ions_base, ONLY : nat, ityp
USE uspp_param, ONLY : upf, nh, nhm
USE uspp, ONLY : nkb, ijtoh, indv_ijkb0
USE uspp, ONLY : nkb, ijtoh, ofsbeta
USE noncollin_module, ONLY : nspin_mag
USE fft_types, ONLY : fft_type_descriptor
USE realus, ONLY : tabxx
@ -715,7 +715,7 @@ MODULE us_exx
!
DO ih = 1, nh(nt)
DO jh = 1, nh(nt)
ijkb0 = indv_ijkb0(ia)
ijkb0 = ofsbeta(ia)
ikb = ijkb0 + ih
jkb = ijkb0 + jh
!
@ -940,7 +940,7 @@ MODULE us_exx
USE io_global, ONLY : stdout
USE ions_base, ONLY : tau, nat, ityp
USE symm_base, ONLY : irt, d1, d2, d3, s, nsym
USE uspp, ONLY : nkb, indv_ijkb0, nhtolm, nhtol
USE uspp, ONLY : nkb, ofsbeta, nhtolm, nhtol
USE uspp_param, ONLY : nh, upf
USE wvfct, ONLY : nbnd
USE becmod, ONLY : allocate_bec_type, is_allocated_bec_type
@ -1041,12 +1041,12 @@ MODULE us_exx
lm_i = nhtolm(ih,nt)
l_i = nhtol(ih,nt)
m_i = lm_i - l_i**2
ikb = indv_ijkb0(ma) + ih
ikb = ofsbeta(ma) + ih
! print*, "doing", ikb, ma, l_i, lm_i
!
DO m_o = 1, 2*l_i +1
oh = ih - m_i + m_o
okb = indv_ijkb0(ia) + oh
okb = ofsbeta(ia) + oh
! WRITE(*,'(a,5i4,2f10.3)') "okb", okb, oh, ih, m_i, m_o, &
! D(l_i)%d(m_o,m_i, isym), &
! D(l_i)%d(m_i,m_o, isym)

6
PW/src/usnldiag.f90
View File

@ -17,7 +17,7 @@ SUBROUTINE usnldiag (npw, h_diag, s_diag)
USE ions_base, ONLY: nat, ityp, ntyp => nsp
USE wvfct, ONLY: npwx
USE lsda_mod, ONLY: current_spin
USE uspp, ONLY: deeq, vkb, qq_at, qq_so, deeq_nc, indv_ijkb0, &
USE uspp, ONLY: deeq, vkb, qq_at, qq_so, deeq_nc, ofsbeta, &
using_vkb
USE uspp_param, ONLY: upf, nh
USE spin_orb, ONLY: lspinorb
@ -63,7 +63,7 @@ SUBROUTINE usnldiag (npw, h_diag, s_diag)
DO na = 1, nat
IF (ityp (na) == nt) THEN
DO ih = 1, nh(nt)
ikb = indv_ijkb0(na) + ih
ikb = ofsbeta(na) + ih
IF (lspinorb) THEN
ps1(1) = deeq_nc (ih, ih, na, 1)
ps1(2) = deeq_nc (ih, ih, na, 4)
@ -88,7 +88,7 @@ SUBROUTINE usnldiag (npw, h_diag, s_diag)
IF ( upf(nt)%tvanp .or.upf(nt)%is_multiproj ) THEN
DO jh = 1, nh (nt)
IF (jh/=ih) THEN
jkb = indv_ijkb0(na) + jh
jkb = ofsbeta(na) + jh
IF (lspinorb) THEN
ps1(1) = deeq_nc (ih, jh, na, 1)
ps1(2) = deeq_nc (ih, jh, na, 4)

14
PW/src/usnldiag_gpu.f90
View File

@ -18,7 +18,7 @@ SUBROUTINE usnldiag_gpu (npw, h_diag_d, s_diag_d)
USE kinds, ONLY: DP
USE ions_base, ONLY: nat, ityp, ntyp => nsp
USE wvfct, ONLY: npwx
USE uspp, ONLY: indv_ijkb0, deeq_d, vkb_d, qq_at_d, qq_so_d, &
USE uspp, ONLY: ofsbeta, deeq_d, vkb_d, qq_at_d, qq_so_d, &
deeq_nc_d, using_vkb_d
USE uspp_param, ONLY: upf, nh
USE spin_orb, ONLY: lspinorb
@ -73,7 +73,7 @@ CONTAINS
IF ( upf(nt)%tvanp .or. upf(nt)%is_multiproj ) THEN
DO na = 1, nat
IF (ityp (na) == nt) THEN
ijkb_start = indv_ijkb0(na)
ijkb_start = ofsbeta(na)
nh_ = nh(nt)
!$cuf kernel do(1) <<<*,*>>>
DO ig = 1, npw
@ -101,7 +101,7 @@ CONTAINS
ELSE
DO na = 1, nat
IF (ityp (na) == nt) THEN
ijkb_start = indv_ijkb0(na)
ijkb_start = ofsbeta(na)
nh_ = nh(nt)
!$cuf kernel do(1) <<<*,*>>>
DO ig = 1, npw
@ -144,7 +144,7 @@ CONTAINS
IF ( upf(nt)%tvanp .or. upf(nt)%is_multiproj ) THEN
DO na = 1, nat
IF (ityp (na) == nt) THEN
ijkb_start = indv_ijkb0(na)
ijkb_start = ofsbeta(na)
nh_ = nh(nt)
!$cuf kernel do(1) <<<*,*>>>
DO ig = 1, npw ! change this to 2*npw ?
@ -178,7 +178,7 @@ CONTAINS
ELSE
DO na = 1, nat
IF (ityp (na) == nt) THEN
ijkb_start = indv_ijkb0(na)
ijkb_start = ofsbeta(na)
nh_ = nh(nt)
!$cuf kernel do(1) <<<*,*>>>
DO ig = 1, npw
@ -227,7 +227,7 @@ CONTAINS
IF ( upf(nt)%tvanp .or. upf(nt)%is_multiproj ) THEN
DO na = 1, nat
IF (ityp (na) == nt) THEN
ijkb_start = indv_ijkb0(na)
ijkb_start = ofsbeta(na)
nh_ = nh(nt)
!$cuf kernel do(1) <<<*,*>>>
DO ig = 1, npw ! change this to 2*npw ?
@ -263,7 +263,7 @@ CONTAINS
ELSE
DO na = 1, nat
IF (ityp (na) == nt) THEN
ijkb_start = indv_ijkb0(na)
ijkb_start = ofsbeta(na)
nh_ = nh(nt)
!$cuf kernel do(1) <<<*,*>>>
DO ig = 1, npw

8
upflib/init_us_1.f90
View File

@ -31,9 +31,9 @@ subroutine init_us_1( nat, ityp, omega, ngm, g, gg, intra_bgrp_comm )
USE uspp_data, ONLY : nqxq, dq, nqx, spline_ps, tab, tab_d2y, qrad, &
tab_d, tab_d2y_d, qrad_d
USE uspp, ONLY : nhtol, nhtoj, nhtolm, ijtoh, dvan, qq_at, qq_nt, indv, &
ap, aainit, qq_so, dvan_so, okvan, indv_ijkb0, &
ap, aainit, qq_so, dvan_so, okvan, ofsbeta, &
nhtol_d, nhtoj_d, nhtolm_d, ijtoh_d, dvan_d, qq_at_d, &
qq_nt_d, indv_d, qq_so_d, dvan_so_d, indv_ijkb0_d
qq_nt_d, indv_d, qq_so_d, dvan_so_d, ofsbeta_d
USE uspp_param, ONLY : upf, lmaxq, nh, nhm, lmaxkb, nbetam, nsp
USE upf_spinorb, ONLY : lspinorb, rot_ylm, fcoef, fcoef_d, lmaxx
USE paw_variables,ONLY : okpaw
@ -165,7 +165,7 @@ subroutine init_us_1( nat, ityp, omega, ngm, g, gg, intra_bgrp_comm )
! atom ia in the global list of beta functions (ijkb0=0 for ia=1)
do ia = 1,nat
IF ( ityp(ia) == nt ) THEN
indv_ijkb0(ia) = ijkb0
ofsbeta(ia) = ijkb0
ijkb0 = ijkb0 + nh(nt)
END IF
enddo
@ -388,7 +388,7 @@ subroutine init_us_1( nat, ityp, omega, ngm, g, gg, intra_bgrp_comm )
dvan_d=dvan
endif
endif
indv_ijkb0_d=indv_ijkb0
ofsbeta_d=ofsbeta
!
#endif
!

74
upflib/obsolete/uspp_gpum.f90
View File

@ -15,7 +15,7 @@
#if defined(__CUDA)
USE cudafor
#endif
USE uspp, ONLY: indv_d, nhtol_d, nhtolm_d, ijtoh_d, indv_ijkb0_d, &
USE uspp, ONLY: indv_d, nhtol_d, nhtolm_d, ijtoh_d, ofsbeta_d, &
vkb_d, becsum_d, ebecsum_d, dvan_d, deeq_d, qq_nt_d, &
qq_at_d, nhtoj_d, qq_so_d, dvan_so_d, deeq_nc_d
IMPLICIT NONE
@ -33,8 +33,8 @@
LOGICAL :: nhtolm_d_ood = .false. ! used to flag out of date variables
LOGICAL :: ijtoh_ood = .false. ! used to flag out of date variables
LOGICAL :: ijtoh_d_ood = .false. ! used to flag out of date variables
LOGICAL :: indv_ijkb0_ood = .false. ! used to flag out of date variables
LOGICAL :: indv_ijkb0_d_ood = .false. ! used to flag out of date variables
LOGICAL :: ofsbeta_ood = .false. ! used to flag out of date variables
LOGICAL :: ofsbeta_d_ood = .false. ! used to flag out of date variables
LOGICAL :: vkb_ood = .false. ! used to flag out of date variables
LOGICAL :: vkb_d_ood = .false. ! used to flag out of date variables
LOGICAL :: becsum_ood = .false. ! used to flag out of date variables
@ -364,14 +364,14 @@
#endif
END SUBROUTINE using_ijtoh_d
!
SUBROUTINE using_indv_ijkb0(intento, debug_info)
SUBROUTINE using_ofsbeta(intento, debug_info)
!
! intento is used to specify what the variable will be used for :
! 0 -> in , the variable needs to be synchronized but won't be changed
! 1 -> inout , the variable needs to be synchronized AND will be changed
! 2 -> out , NO NEED to synchronize the variable, everything will be overwritten
!
USE uspp, ONLY : indv_ijkb0, indv_ijkb0_d
USE uspp, ONLY : ofsbeta, ofsbeta_d
implicit none
INTEGER, INTENT(IN) :: intento
CHARACTER(len=*), INTENT(IN), OPTIONAL :: debug_info
@ -379,66 +379,66 @@
INTEGER :: intento_
intento_ = intento
!
IF (PRESENT(debug_info) ) print *, "using_indv_ijkb0 ", debug_info, indv_ijkb0_ood
IF (PRESENT(debug_info) ) print *, "using_ofsbeta ", debug_info, ofsbeta_ood
!
IF (indv_ijkb0_ood) THEN
IF ((.not. allocated(indv_ijkb0_d)) .and. (intento_ < 2)) THEN
CALL errore('using_indv_ijkb0_d', 'PANIC: sync of indv_ijkb0 from indv_ijkb0_d with unallocated array. Bye!!', 1)
IF (ofsbeta_ood) THEN
IF ((.not. allocated(ofsbeta_d)) .and. (intento_ < 2)) THEN
CALL errore('using_ofsbeta_d', 'PANIC: sync of ofsbeta from ofsbeta_d with unallocated array. Bye!!', 1)
stop
END IF
IF (.not. allocated(indv_ijkb0)) THEN
IF (.not. allocated(ofsbeta)) THEN
IF (intento_ /= 2) THEN
print *, "WARNING: sync of indv_ijkb0 with unallocated array and intento /= 2? Changed to 2!"
print *, "WARNING: sync of ofsbeta with unallocated array and intento /= 2? Changed to 2!"
intento_ = 2
END IF
! IF (intento_ > 0) indv_ijkb0_d_ood = .true.
! IF (intento_ > 0) ofsbeta_d_ood = .true.
END IF
IF (intento_ < 2) THEN
IF ( iverbosity > 0 ) print *, "Really copied indv_ijkb0 D->H"
indv_ijkb0 = indv_ijkb0_d
IF ( iverbosity > 0 ) print *, "Really copied ofsbeta D->H"
ofsbeta = ofsbeta_d
END IF
indv_ijkb0_ood = .false.
ofsbeta_ood = .false.
ENDIF
IF (intento_ > 0) indv_ijkb0_d_ood = .true.
IF (intento_ > 0) ofsbeta_d_ood = .true.
#endif
END SUBROUTINE using_indv_ijkb0
END SUBROUTINE using_ofsbeta
!
SUBROUTINE using_indv_ijkb0_d(intento, debug_info)
SUBROUTINE using_ofsbeta_d(intento, debug_info)
!
USE uspp, ONLY : indv_ijkb0, indv_ijkb0_d
USE uspp, ONLY : ofsbeta, ofsbeta_d
implicit none
INTEGER, INTENT(IN) :: intento
CHARACTER(len=*), INTENT(IN), OPTIONAL :: debug_info
#if defined(__CUDA) || defined(__CUDA_GNU)
!
IF (PRESENT(debug_info) ) print *, "using_indv_ijkb0_d ", debug_info, indv_ijkb0_d_ood
IF (PRESENT(debug_info) ) print *, "using_ofsbeta_d ", debug_info, ofsbeta_d_ood
!
IF (.not. allocated(indv_ijkb0)) THEN
IF (intento /= 2) print *, "WARNING: sync of indv_ijkb0_d with unallocated array and intento /= 2?"
IF (allocated(indv_ijkb0_d)) DEALLOCATE(indv_ijkb0_d)
indv_ijkb0_d_ood = .false.
IF (.not. allocated(ofsbeta)) THEN
IF (intento /= 2) print *, "WARNING: sync of ofsbeta_d with unallocated array and intento /= 2?"
IF (allocated(ofsbeta_d)) DEALLOCATE(ofsbeta_d)
ofsbeta_d_ood = .false.
RETURN
END IF
! here we know that indv_ijkb0 is allocated, check if size is 0
IF ( SIZE(indv_ijkb0) == 0 ) THEN
print *, "Refusing to allocate 0 dimensional array indv_ijkb0_d. If used, code will crash."
! here we know that ofsbeta is allocated, check if size is 0
IF ( SIZE(ofsbeta) == 0 ) THEN
print *, "Refusing to allocate 0 dimensional array ofsbeta_d. If used, code will crash."
RETURN
END IF
!
IF (indv_ijkb0_d_ood) THEN
IF ( allocated(indv_ijkb0_d) .and. (SIZE(indv_ijkb0_d)/=SIZE(indv_ijkb0))) deallocate(indv_ijkb0_d)
IF (.not. allocated(indv_ijkb0_d)) ALLOCATE(indv_ijkb0_d(DIMS1D(indv_ijkb0))) ! MOLD does not work on all compilers
IF (ofsbeta_d_ood) THEN
IF ( allocated(ofsbeta_d) .and. (SIZE(ofsbeta_d)/=SIZE(ofsbeta))) deallocate(ofsbeta_d)
IF (.not. allocated(ofsbeta_d)) ALLOCATE(ofsbeta_d(DIMS1D(ofsbeta))) ! MOLD does not work on all compilers
IF (intento < 2) THEN
IF ( iverbosity > 0 ) print *, "Really copied indv_ijkb0 H->D"
indv_ijkb0_d = indv_ijkb0
IF ( iverbosity > 0 ) print *, "Really copied ofsbeta H->D"
ofsbeta_d = ofsbeta
END IF
indv_ijkb0_d_ood = .false.
ofsbeta_d_ood = .false.
ENDIF
IF (intento > 0) indv_ijkb0_ood = .true.
IF (intento > 0) ofsbeta_ood = .true.
#else
CALL errore('using_indv_ijkb0_d', 'Trying to use device data without device compilated code!', 1)
CALL errore('using_ofsbeta_d', 'Trying to use device data without device compilated code!', 1)
#endif
END SUBROUTINE using_indv_ijkb0_d
END SUBROUTINE using_ofsbeta_d
!
SUBROUTINE using_vkb(intento, debug_info)
!
@ -1281,7 +1281,7 @@
nhtol_d_ood = .false.
nhtolm_d_ood = .false.
ijtoh_d_ood = .false.
indv_ijkb0_d_ood = .false.
ofsbeta_d_ood = .false.
vkb_d_ood = .false.
becsum_d_ood = .false.
ebecsum_d_ood = .false.

18
upflib/uspp.f90
View File

@ -46,10 +46,10 @@ MODULE uspp
PRIVATE
SAVE
!
PUBLIC :: nlx, lpx, lpl, ap, aainit, indv, nhtol, nhtolm, indv_ijkb0, &
PUBLIC :: nlx, lpx, lpl, ap, aainit, indv, nhtol, nhtolm, ofsbeta, &
nkb, nkbus, vkb, dvan, deeq, qq_at, qq_nt, nhtoj, ijtoh, beta, &
becsum, ebecsum
PUBLIC :: lpx_d, lpl_d, ap_d, indv_d, nhtol_d, nhtolm_d, indv_ijkb0_d, &
PUBLIC :: lpx_d, lpl_d, ap_d, indv_d, nhtol_d, nhtolm_d, ofsbeta_d, &
vkb_d, dvan_d, deeq_d, qq_at_d, qq_nt_d, nhtoj_d, ijtoh_d, &
becsum_d, ebecsum_d
PUBLIC :: okvan, nlcc_any
@ -94,7 +94,7 @@ MODULE uspp
nhtol(:,:), &! correspondence n <-> angular momentum l
nhtolm(:,:), &! correspondence n <-> combined lm index for (l,m)
ijtoh(:,:,:), &! correspondence beta indexes ih,jh -> composite index ijh
indv_ijkb0(:) ! first beta (index in the solid) for each atom
ofsbeta(:) ! first beta (index in the solid) for each atom
!
! GPU vars
!
@ -102,9 +102,9 @@ MODULE uspp
INTEGER, ALLOCATABLE :: nhtol_d(:,:)
INTEGER, ALLOCATABLE :: nhtolm_d(:,:)
INTEGER, ALLOCATABLE :: ijtoh_d(:,:,:)
INTEGER, ALLOCATABLE :: indv_ijkb0_d(:)
INTEGER, ALLOCATABLE :: ofsbeta_d(:)
#if defined (__CUDA)
attributes(DEVICE) :: indv_d, nhtol_d, nhtolm_d, ijtoh_d, indv_ijkb0_d
attributes(DEVICE) :: indv_d, nhtol_d, nhtolm_d, ijtoh_d, ofsbeta_d
#endif
LOGICAL :: &
@ -400,7 +400,7 @@ CONTAINS
if (tqr) then
allocate(ebecsum( nhm*(nhm+1)/2, nat, nspin))
endif
allocate( indv_ijkb0(nat) )
allocate( ofsbeta(nat) )
!
! GPU-vars (protecting zero-size allocations)
!
@ -431,7 +431,7 @@ CONTAINS
endif
!
endif
allocate( indv_ijkb0_d(nat) )
allocate( ofsbeta_d(nat) )
!
endif
!
@ -445,7 +445,7 @@ CONTAINS
IF( ALLOCATED( indv ) ) DEALLOCATE( indv )
IF( ALLOCATED( nhtolm ) ) DEALLOCATE( nhtolm )
IF( ALLOCATED( nhtoj ) ) DEALLOCATE( nhtoj )
IF( ALLOCATED( indv_ijkb0 ) ) DEALLOCATE( indv_ijkb0 )
IF( ALLOCATED( ofsbeta ) ) DEALLOCATE( ofsbeta )
IF( ALLOCATED( ijtoh ) ) DEALLOCATE( ijtoh )
IF( ALLOCATED( vkb ) ) DEALLOCATE( vkb )
IF( ALLOCATED( becsum ) ) DEALLOCATE( becsum )
@ -469,7 +469,7 @@ CONTAINS
IF( ALLOCATED( nhtol_d ) ) DEALLOCATE( nhtol_d )
IF( ALLOCATED( nhtolm_d ) ) DEALLOCATE( nhtolm_d )
IF( ALLOCATED( ijtoh_d ) ) DEALLOCATE( ijtoh_d )
IF( ALLOCATED( indv_ijkb0_d)) DEALLOCATE( indv_ijkb0_d )
IF( ALLOCATED( ofsbeta_d)) DEALLOCATE( ofsbeta_d )
IF( ALLOCATED( vkb_d ) ) DEALLOCATE( vkb_d )
IF( ALLOCATED( becsum_d ) ) DEALLOCATE( becsum_d )
IF( ALLOCATED( ebecsum_d ) ) DEALLOCATE( ebecsum_d )