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

Add KIND=DP to CMPLX

This commit is contained in:
Victor Yu 2023-05-21 11:13:42 -05:00
parent 160f494749
commit 595cda70ce
17 changed files with 90 additions and 90 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
PW/src/Coul_cut_2D.f90
View File

@ -636,9 +636,9 @@ SUBROUTINE cutoff_stres_sigmaewa( alpha, sdewald, sigmaewa )
DO na = 1, nat
arg = (g(1,ng) * tau(1,na) + g(2,ng) * tau(2,na) + &
g(3,ng) * tau(3,na) ) * tpi
rhostar = rhostar + CMPLX(zv(ityp(na))) * CMPLX(COS(arg),SIN(arg),KIND=DP)
rhostar = rhostar + CMPLX(zv(ityp(na)),KIND=DP) * CMPLX(COS(arg),SIN(arg),KIND=DP)
ENDDO
rhostar = rhostar / CMPLX(omega)
rhostar = rhostar / CMPLX(omega,KIND=DP)
sewald = tpi * e2 * EXP(-g2a) / g2* cutoff_2D(ng) * ABS(rhostar)**2
! ... sewald is an other diagonal term that is similar to the diagonal terms
! in the other stress contributions. It basically gives a term prop to

2
PW/src/add_dmft_occ.f90
View File

@ -144,7 +144,7 @@ CONTAINS
!
! ... set corrections to the DFT occupations from DMFT for each band in nbnd_c at each ik
!
n_dmft_root(:,:,:) = CMPLX(delta_n(1,:,:,:), delta_n(2,:,:,:))
n_dmft_root(:,:,:) = CMPLX(delta_n(1,:,:,:), delta_n(2,:,:,:), KIND=DP)
!
CALL h5dclose_f(d_id, ierr)
CALL h5gclose_f(g_id, ierr)

56
PW/src/atomic_wfc_gpu.f90
View File

@ -193,7 +193,7 @@ CONTAINS
!$cuf kernel do (1) <<<*,*>>>
DO ig = 1, npw
aux_d(ig) = aux_d(ig) + rot_ylm_in1 * &
CMPLX(ylm_d(ig,ind1))
CMPLX(ylm_d(ig,ind1), KIND=DP)
ENDDO
ENDIF
ENDDO
@ -201,7 +201,7 @@ CONTAINS
DO ig = 1, npw
wfcatom_d(ig,is,n_starting_wfc) = lphase * &
sk_d(ig)*aux_d(ig)*CMPLX(fact_is* &
chiq_d(ig,nb,nt))
chiq_d(ig,nb,nt), KIND=DP)
END DO
ELSE
wfcatom_d(:,is,n_starting_wfc) = (0.d0,0.d0)
@ -279,7 +279,7 @@ CONTAINS
!
!$cuf kernel do (1) <<<*,*>>>
DO ig = 1, npw
aux_d(ig) = sk_d(ig)* CMPLX(ylm_d(ig,lm)*chiaux_d(ig))
aux_d(ig) = sk_d(ig)* CMPLX(ylm_d(ig,lm)*chiaux_d(ig), KIND=DP)
END DO
!
! now, rotate wfc as needed
@ -287,31 +287,31 @@ CONTAINS
!
!$cuf kernel do (1) <<<*,*>>>
DO ig = 1, npw
fup = CMPLX(COS(0.5d0*alpha))*aux_d(ig)
fdown = (0.d0,1.d0)*CMPLX(SIN(0.5d0*alpha))*aux_d(ig)
fup = CMPLX(COS(0.5d0*alpha), KIND=DP)*aux_d(ig)
fdown = (0.d0,1.d0)*CMPLX(SIN(0.5d0*alpha), KIND=DP)*aux_d(ig)
!
! Now, build the orthogonal wfc
! first rotation with angle (alpha+pi) around (OX)
!
wfcatom_d(ig,1,n_starting_wfc) = (CMPLX(COS(0.5d0*gamman)) &
+(0.d0,1.d0)*CMPLX(SIN(0.5d0*gamman)))*fup
wfcatom_d(ig,2,n_starting_wfc) = (CMPLX(COS(0.5d0*gamman)) &
-(0.d0,1.d0)*CMPLX(SIN(0.5d0*gamman)))*fdown
wfcatom_d(ig,1,n_starting_wfc) = (CMPLX(COS(0.5d0*gamman), KIND=DP) &
+(0.d0,1.d0)*CMPLX(SIN(0.5d0*gamman), KIND=DP))*fup
wfcatom_d(ig,2,n_starting_wfc) = (CMPLX(COS(0.5d0*gamman), KIND=DP) &
-(0.d0,1.d0)*CMPLX(SIN(0.5d0*gamman), KIND=DP))*fdown
!
! second: rotation with angle gamma around (OZ)
!
! Now, build the orthogonal wfc
! first rotation with angle (alpha+pi) around (OX)
!
fup = CMPLX(COS(0.5d0*(alpha+pi)))*aux_d(ig)
fup = CMPLX(COS(0.5d0*(alpha+pi)), KIND=DP)*aux_d(ig)
fdown = (0.d0,1.d0)*CMPLX(SIN(0.5d0*(alpha+pi)))*aux_d(ig)
!
! second, rotation with angle gamma around (OZ)
!
wfcatom_d(ig,1,n_starting_wfc+2*l+1) = (CMPLX(COS(0.5d0*gamman)) &
+(0.d0,1.d0)*CMPLX(SIN(0.5d0 *gamman)))*fup
wfcatom_d(ig,2,n_starting_wfc+2*l+1) = (CMPLX(COS(0.5d0*gamman)) &
-(0.d0,1.d0)*CMPLX(SIN(0.5d0*gamman)))*fdown
wfcatom_d(ig,1,n_starting_wfc+2*l+1) = (CMPLX(COS(0.5d0*gamman), KIND=DP) &
+(0.d0,1.d0)*CMPLX(SIN(0.5d0 *gamman), KIND=DP))*fup
wfcatom_d(ig,2,n_starting_wfc+2*l+1) = (CMPLX(COS(0.5d0*gamman), KIND=DP) &
-(0.d0,1.d0)*CMPLX(SIN(0.5d0*gamman), KIND=DP))*fdown
END DO
END DO
!
@ -340,7 +340,7 @@ CONTAINS
('atomic_wfc_nc', 'internal error: too many wfcs', 1)
!$cuf kernel do (1) <<<*,*>>>
DO ig = 1, npw
aux_d(ig) = sk_d(ig)*CMPLX(ylm_d(ig,lm)*chiq_d(ig,nb,nt))
aux_d(ig) = sk_d(ig)*CMPLX(ylm_d(ig,lm)*chiq_d(ig,nb,nt), KIND=DP)
END DO
!
! now, rotate wfc as needed
@ -348,31 +348,31 @@ CONTAINS
!
!$cuf kernel do (1) <<<*,*>>>
DO ig = 1, npw
fup = CMPLX(COS(0.5d0*alpha))*aux_d(ig)
fdown = (0.d0,1.d0)*CMPLX(SIN(0.5d0*alpha))*aux_d(ig)
fup = CMPLX(COS(0.5d0*alpha), KIND=DP)*aux_d(ig)
fdown = (0.d0,1.d0)*CMPLX(SIN(0.5d0*alpha), KIND=DP)*aux_d(ig)
!
! Now, build the orthogonal wfc
! first rotation with angle (alpha+pi) around (OX)
!
wfcatom_d(ig,1,n_starting_wfc) = (CMPLX(COS(0.5d0*gamman)) &
+(0.d0,1.d0)*CMPLX(SIN(0.5d0*gamman)))*fup
wfcatom_d(ig,2,n_starting_wfc) = (CMPLX(COS(0.5d0*gamman)) &
-(0.d0,1.d0)*CMPLX(SIN(0.5d0*gamman)))*fdown
wfcatom_d(ig,1,n_starting_wfc) = (CMPLX(COS(0.5d0*gamman), KIND=DP) &
+(0.d0,1.d0)*CMPLX(SIN(0.5d0*gamman), KIND=DP))*fup
wfcatom_d(ig,2,n_starting_wfc) = (CMPLX(COS(0.5d0*gamman), KIND=DP) &
-(0.d0,1.d0)*CMPLX(SIN(0.5d0*gamman), KIND=DP))*fdown
!
! second: rotation with angle gamma around (OZ)
!
! Now, build the orthogonal wfc
! first rotation with angle (alpha+pi) around (OX)
!
fup = CMPLX(COS(0.5d0*(alpha+pi)))*aux_d(ig)
fdown = (0.d0,1.d0)*CMPLX(SIN(0.5d0*(alpha+pi)))*aux_d(ig)
fup = CMPLX(COS(0.5d0*(alpha+pi)), KIND=DP)*aux_d(ig)
fdown = (0.d0,1.d0)*CMPLX(SIN(0.5d0*(alpha+pi)), KIND=DP)*aux_d(ig)
!
! second, rotation with angle gamma around (OZ)
!
wfcatom_d(ig,1,n_starting_wfc+2*l+1) = (CMPLX(COS(0.5d0*gamman)) &
+(0.d0,1.d0)*CMPLX(SIN(0.5d0*gamman)))*fup
wfcatom_d(ig,2,n_starting_wfc+2*l+1) = (CMPLX(COS(0.5d0*gamman)) &
-(0.d0,1.d0)*CMPLX(SIN(0.5d0*gamman)))*fdown
wfcatom_d(ig,1,n_starting_wfc+2*l+1) = (CMPLX(COS(0.5d0*gamman), KIND=DP) &
+(0.d0,1.d0)*CMPLX(SIN(0.5d0*gamman), KIND=DP))*fup
wfcatom_d(ig,2,n_starting_wfc+2*l+1) = (CMPLX(COS(0.5d0*gamman), KIND=DP) &
-(0.d0,1.d0)*CMPLX(SIN(0.5d0*gamman), KIND=DP))*fdown
END DO
END DO
n_starting_wfc = n_starting_wfc + 2*l+1
@ -395,7 +395,7 @@ CONTAINS
!$cuf kernel do (1) <<<*,*>>>
DO ig = 1, npw
wfcatom_d(ig,1,n_starting_wfc) = lphase * &
sk_d(ig) * CMPLX(ylm_d(ig,lm) * chiq_d(ig,nb,nt))
sk_d(ig) * CMPLX(ylm_d(ig,lm) * chiq_d(ig,nb,nt), KIND=DP)
ENDDO
!
END DO

4
PW/src/bp_c_phase.f90
View File

@ -716,8 +716,8 @@ SUBROUTINE c_phase
zeta_mod= DBLE(CONJG(zeta)*zeta)
!REC if zeta_mod=0 then angle is zero!
if(zeta_mod.le.eps)then
phik(istring)=0d0
cphik(istring)=cmplx(1d0,0d0)
phik(istring)=0._DP
cphik(istring)=CMPLX(1._DP,0._DP,KIND=DP)
endif
! --- End loop over orthogonal k-points ---

4
PW/src/compute_deff.f90
View File

@ -104,7 +104,7 @@ SUBROUTINE compute_deff_nc( deff_nc, et )
DO j = 1, nhm
na = na_v(ias)
nt = nt_v(ias)
deff_nc(i,j,na,:) = deeq_nc(i,j,na,:) - CMPLX(et)*qq_so(i,j,:,nt)
deff_nc(i,j,na,:) = deeq_nc(i,j,na,:) - CMPLX(et,KIND=DP)*qq_so(i,j,:,nt)
ENDDO
ENDDO
ENDDO
@ -119,7 +119,7 @@ SUBROUTINE compute_deff_nc( deff_nc, et )
!$acc loop seq
DO is = 1, npol
ijs = (is-1)*npol + is
deff_nc(i,j,na,ijs) = deeq_nc(i,j,na,ijs) - CMPLX(et*qq_at(i,j,na))
deff_nc(i,j,na,ijs) = deeq_nc(i,j,na,ijs) - CMPLX(et*qq_at(i,j,na),KIND=DP)
ENDDO
ENDDO
ENDDO

2
PW/src/gradcorr.f90
View File

@ -99,7 +99,7 @@ SUBROUTINE gradcorr( rho, rhog, rho_core, rhog_core, etxc, vtxc, v )
DO is = 1, nspin0
DO ir = 1, ngm
sgn_is = DBLE(3-2*is)
rhogaux(ir,is) = ( rhog(ir,1) + CMPLX(sgn_is) * rhog(ir,nspin0) ) &
rhogaux(ir,is) = ( rhog(ir,1) + CMPLX(sgn_is,KIND=DP) * rhog(ir,nspin0) ) &
* (0.5_DP,0._DP)
ENDDO
ENDDO

8
PW/src/h_psi_meta.f90
View File

@ -66,8 +66,8 @@ SUBROUTINE h_psi_meta( ldap, np, mp, psip, hpsi )
!
DO i = 1, np
kplusgi = (xk(j,current_k)+g(j,i)) * tpiba
psi_g(i,1) = CMPLX(0.D0,kplusgi) * psip(i,im)
IF ( im < mp ) psi_g(i,2) = CMPLX(0.d0,kplusgi) * psip(i,im+1)
psi_g(i,1) = CMPLX(0._DP,kplusgi,KIND=DP) * psip(i,im)
IF ( im < mp ) psi_g(i,2) = CMPLX(0._DP,kplusgi,KIND=DP) * psip(i,im+1)
ENDDO
!
ebnd = im
@ -98,7 +98,7 @@ SUBROUTINE h_psi_meta( ldap, np, mp, psip, hpsi )
!
DO i = 1, np
kplusgi = (xk(j,current_k)+g(j,igk_k(i,current_k)))*tpiba
psi_g(i,1) = CMPLX(0.D0,kplusgi,kind=DP) * psip(i,im)
psi_g(i,1) = CMPLX(0._DP,kplusgi,KIND=DP) * psip(i,im)
ENDDO
!
CALL wave_g2r( psi_g(1:np,1:1), psic, dffts, igk=igk_k(:,current_k) )
@ -109,7 +109,7 @@ SUBROUTINE h_psi_meta( ldap, np, mp, psip, hpsi )
!
DO i = 1, np
kplusgi = (xk(j,current_k)+g(j,igk_k(i,current_k)))*tpiba
hpsi(i,im) = hpsi(i,im) - CMPLX(0.D0,kplusgi,KIND=DP) * psi_g(i,1)
hpsi(i,im) = hpsi(i,im) - CMPLX(0._DP,kplusgi,KIND=DP) * psi_g(i,1)
ENDDO
!
ENDDO

4
PW/src/plugin_int_forces.f90
View File

@ -56,11 +56,11 @@ SUBROUTINE external_wg_corr_force( rhor, force )
COMPLEX (DP), ALLOCATABLE :: auxg( : ), auxr( : )
!
allocate(auxr(dfftp%nnr))
auxr = cmplx(rhor,0.0_dp)
auxr = cmplx(rhor,0.0_dp,kind=dp)
call fwfft ("Rho", auxr, dfftp)
!
allocate(auxg(ngm))
auxg = cmplx(0.0_dp,0.0_dp)
auxg = cmplx(0.0_dp,0.0_dp,kind=dp)
auxg(:)=auxr(dfftp%nl(:))
deallocate(auxr)
!

2
PW/src/scf_mod.f90
View File

@ -622,7 +622,7 @@ CONTAINS
IF (lda_plus_u_cob) CALL DCOPY(rlen_ldaUb,rho%nsb, 1,io_buffer(start_ldaUb),1)
IF (okpaw) CALL DCOPY(rlen_bec, rho%bec, 1,io_buffer(start_bec), 1)
!
IF (dipfield) io_buffer(start_dipole) = CMPLX( rho%el_dipole, 0.0_dp )
IF (dipfield) io_buffer(start_dipole) = CMPLX( rho%el_dipole, 0.0_dp, KIND=DP )
IF (sic) CALL DCOPY(rlen_pol, rho%pol_g, 1,io_buffer(start_pol),1)
!
CALL save_buffer( io_buffer, record_length, iunit, record )

4
PW/src/stres_ewa.f90
View File

@ -150,9 +150,9 @@ SUBROUTINE stres_ewa( alat, nat, ntyp, ityp, zv, at, bg, tau, &
DO na = 1, nat
arg = (g(1,ng) * tau(1,na) + g(2,ng) * tau(2,na) + &
g(3,ng) * tau(3,na) ) * tpi
rhostar = rhostar + CMPLX(zv(ityp(na))) * CMPLX(COS(arg), SIN(arg), KIND=DP)
rhostar = rhostar + CMPLX(zv(ityp(na)), KIND=DP) * CMPLX(COS(arg), SIN(arg), KIND=DP)
ENDDO
rhostar = rhostar / CMPLX(omega)
rhostar = rhostar / CMPLX(omega, KIND=DP)
sewald = fact * tpi * e2 * EXP(-g2a) / g2 * ABS(rhostar)**2
sdewald = sdewald - sewald
!

6
PW/src/stres_mgga.f90
View File

@ -238,8 +238,8 @@ SUBROUTINE wfc_gradient( ibnd, ik, npw, gradpsi )
!$acc parallel loop
DO j = 1, npw
kplusgi = (xki+g(ipol,igk_k(j,ik))) * tpiba
kplusg_evc(j,1) = CMPLX(0.D0,kplusgi) * evc(j,ibnd)
IF ( ibnd<nbnd ) kplusg_evc(j,2) = CMPLX(0.d0,kplusgi) * evc(j,ibnd+1)
kplusg_evc(j,1) = CMPLX(0._DP,kplusgi,KIND=DP) * evc(j,ibnd)
IF ( ibnd<nbnd ) kplusg_evc(j,2) = CMPLX(0._DP,kplusgi,KIND=DP) * evc(j,ibnd+1)
ENDDO
!
CALL wave_g2r( kplusg_evc(1:npw,1:brange), gradpsi(:,ipol), dffts )
@ -257,7 +257,7 @@ SUBROUTINE wfc_gradient( ibnd, ik, npw, gradpsi )
!$acc parallel loop
DO j = 1, npw
kplusgi = (xki+g(ipol,igk_k(j,ik))) * tpiba
kplusg_evc(j,1) = CMPLX(0.D0,kplusgi,kind=DP) * evc(j,ibnd)
kplusg_evc(j,1) = CMPLX(0._DP,kplusgi,KIND=DP) * evc(j,ibnd)
ENDDO
!
CALL wave_g2r( kplusg_evc(1:npw,1:1), gradpsi(:,ipol), dffts, igk=igk_k(:,ik) )

52
PW/src/stres_us.f90
View File

@ -292,12 +292,12 @@ SUBROUTINE stres_us( ik, gk, sigmanlc )
ishift = ishift_list(i) ; ikb = ishift + ih
!
IF (.NOT. is_multinp(i)) THEN
ps(ikb) = CMPLX(deff(ih,ih,na) * becpr(ikb,ibnd_loc))
ps(ikb) = CMPLX(deff(ih,ih,na) * becpr(ikb,ibnd_loc), KIND=DP)
ELSE
nh_np = nh_list(i)
!
ps(ikb) = CMPLX( SUM( becpr(ishift+1:ishift+nh_np,ibnd_loc) &
* deff(ih,1:nh_np,na) ) )
* deff(ih,1:nh_np,na) ), KIND=DP )
ENDIF
ENDDO
!
@ -321,22 +321,22 @@ SUBROUTINE stres_us( ik, gk, sigmanlc )
gk1 = gk(i,1) ; gk2 = gk(i,2) ; gk3 = gk(i,3)
qm1i = qm1(i)
!
cv = evci * CMPLX(gk1 * gk1 * qm1i)
cv = evci * CMPLX(gk1 * gk1 * qm1i, KIND=DP)
dot11 = dot11 + Re_worksum*DBLE(cv) + Im_worksum*DIMAG(cv)
!
cv = evci * CMPLX(gk2 * gk1 * qm1i)
cv = evci * CMPLX(gk2 * gk1 * qm1i, KIND=DP)
dot21 = dot21 + Re_worksum*DBLE(cv) + Im_worksum*DIMAG(cv)
!
cv = evci * CMPLX(gk3 * gk1 * qm1i)
cv = evci * CMPLX(gk3 * gk1 * qm1i, KIND=DP)
dot31 = dot31 + Re_worksum*DBLE(cv) + Im_worksum*DIMAG(cv)
!
cv = evci * CMPLX(gk2 * gk2 * qm1i)
cv = evci * CMPLX(gk2 * gk2 * qm1i, KIND=DP)
dot22 = dot22 + Re_worksum*DBLE(cv) + Im_worksum*DIMAG(cv)
!
cv = evci * CMPLX(gk3 * gk2 * qm1i)
cv = evci * CMPLX(gk3 * gk2 * qm1i, KIND=DP)
dot32 = dot32 + Re_worksum*DBLE(cv) + Im_worksum*DIMAG(cv)
!
cv = evci * CMPLX(gk3 * gk3 * qm1i)
cv = evci * CMPLX(gk3 * gk3 * qm1i, KIND=DP)
dot33 = dot33 + Re_worksum*DBLE(cv) + Im_worksum*DIMAG(cv)
ENDDO
ENDDO
@ -365,16 +365,16 @@ SUBROUTINE stres_us( ik, gk, sigmanlc )
gk2 = gk(i,2)
gk3 = gk(i,3)
!
cv = evci * CMPLX(gk1)
cv = evci * CMPLX(gk1, KIND=DP)
dot11 = dot11 + DBLE(wsum1)* DBLE(cv) + DIMAG(wsum1)*DIMAG(cv)
dot21 = dot21 + DBLE(wsum2)* DBLE(cv) + DIMAG(wsum2)*DIMAG(cv)
dot31 = dot31 + DBLE(wsum3)* DBLE(cv) + DIMAG(wsum3)*DIMAG(cv)
!
cv = evci * CMPLX(gk2)
cv = evci * CMPLX(gk2, KIND=DP)
dot22 = dot22 + DBLE(wsum2)* DBLE(cv) + DIMAG(wsum2)*DIMAG(cv)
dot32 = dot32 + DBLE(wsum3)* DBLE(cv) + DIMAG(wsum3)*DIMAG(cv)
!
cv = evci * CMPLX(gk3)
cv = evci * CMPLX(gk3, KIND=DP)
dot33 = dot33 + DBLE(wsum3)* DBLE(cv) + DIMAG(wsum3)*DIMAG(cv)
ENDDO
ENDDO
@ -669,7 +669,7 @@ SUBROUTINE stres_us( ik, gk, sigmanlc )
ishift = ishift_list(i) ; ikb = ishift + ih
!
IF (.NOT. is_multinp(i)) THEN
ps(ikb) = CMPLX(deeq(ih,ih,na,current_spin)) * &
ps(ikb) = CMPLX(deeq(ih,ih,na,current_spin), KIND=DP) * &
becpk(ikb,ibnd)
ELSE
nh_np = nh_list(i)
@ -700,10 +700,10 @@ SUBROUTINE stres_us( ik, gk, sigmanlc )
DO i = 1, npw
evc1i = evcv(i)
evc2i = evcv(i+npwx)
qm1i = CMPLX(qm1(i))
gk1 = CMPLX(gk(i,1))
gk2 = CMPLX(gk(i,2))
gk3 = CMPLX(gk(i,3))
qm1i = CMPLX(qm1(i), KIND=DP)
gk1 = CMPLX(gk(i,1), KIND=DP)
gk2 = CMPLX(gk(i,2), KIND=DP)
gk3 = CMPLX(gk(i,3), KIND=DP)
worksum1 = ps_nc(ikb,1) * dvkb(i,ikb,4)
worksum2 = ps_nc(ikb,2) * dvkb(i,ikb,4)
Re_worksum1 = DBLE(worksum1) ; Im_worksum1 = DIMAG(worksum1)
@ -760,10 +760,10 @@ SUBROUTINE stres_us( ik, gk, sigmanlc )
Re_worksum = DBLE(worksum) ; Im_worksum = DIMAG(worksum)
!
evci = evcv(i)
qm1i = CMPLX(qm1(i))
gk1 = CMPLX(gk(i,1))
gk2 = CMPLX(gk(i,2))
gk3 = CMPLX(gk(i,3))
qm1i = CMPLX(qm1(i), KIND=DP)
gk1 = CMPLX(gk(i,1), KIND=DP)
gk2 = CMPLX(gk(i,2), KIND=DP)
gk3 = CMPLX(gk(i,3), KIND=DP)
!
cv = evci * gk1 * gk1 * qm1i
dot11 = dot11 + Re_worksum*DBLE(cv) + Im_worksum*DIMAG(cv)
@ -815,9 +815,9 @@ SUBROUTINE stres_us( ik, gk, sigmanlc )
DO ikb =1, nkb
DO i = 1, npw
!
gk1 = CMPLX(gk(i,1))
gk2 = CMPLX(gk(i,2))
gk3 = CMPLX(gk(i,3))
gk1 = CMPLX(gk(i,1), KIND=DP)
gk2 = CMPLX(gk(i,2), KIND=DP)
gk3 = CMPLX(gk(i,3), KIND=DP)
!
ps1 = ps_nc(ikb,1)
ps2 = ps_nc(ikb,2)
@ -879,9 +879,9 @@ SUBROUTINE stres_us( ik, gk, sigmanlc )
psd2 = pss*dvkb(i,ikb,2)
psd3 = pss*dvkb(i,ikb,3)
evci = evcv(i)
gk1 = CMPLX(gk(i,1))
gk2 = CMPLX(gk(i,2))
gk3 = CMPLX(gk(i,3))
gk1 = CMPLX(gk(i,1), KIND=DP)
gk2 = CMPLX(gk(i,2), KIND=DP)
gk3 = CMPLX(gk(i,3), KIND=DP)
!
cv = evci * gk1
dot11 = dot11 + DBLE(psd1)*DBLE(cv) + DIMAG(psd1)*DIMAG(cv)

6
PW/src/sum_band.f90
View File

@ -422,8 +422,8 @@ SUBROUTINE sum_band()
DO j = 1, 3
DO i = 1, npw
kplusgi = (xk(j,ik)+g(j,i)) * tpiba
kplusg_evc(i,1) = CMPLX(0.D0,kplusgi) * evc(i,ibnd)
IF ( ibnd < ibnd_end ) kplusg_evc(i,2) = CMPLX(0.d0,kplusgi) * evc(i,ibnd+1)
kplusg_evc(i,1) = CMPLX(0._DP,kplusgi,KIND=DP) * evc(i,ibnd)
IF ( ibnd < ibnd_end ) kplusg_evc(i,2) = CMPLX(0._DP,kplusgi,KIND=DP) * evc(i,ibnd+1)
ENDDO
!
ebnd = ibnd
@ -712,7 +712,7 @@ SUBROUTINE sum_band()
DO j = 1, 3
DO i = 1, npw
kplusgi = (xk(j,ik)+g(j,igk_k(i,ik))) * tpiba
kplusg_evc(i,1) = CMPLX(0.D0,kplusgi,kind=DP) * evc(i,ibnd)
kplusg_evc(i,1) = CMPLX(0._DP,kplusgi,KIND=DP) * evc(i,ibnd)
ENDDO
!
CALL wave_g2r( kplusg_evc(1:npw,1:1), psic, dffts, igk=igk_k(:,ik) )

6
PW/src/sum_band_gpu.f90
View File

@ -433,8 +433,8 @@ SUBROUTINE sum_band_gpu()
DO j = 1, 3
DO i = 1, npw
kplusgi = (xk(j,ik)+g(j,i)) * tpiba
kplusg_evc(i,1) = CMPLX(0.D0,kplusgi) * evc(i,ibnd)
IF ( ibnd < ibnd_end ) kplusg_evc(i,2) = CMPLX(0.d0,kplusgi) * evc(i,ibnd+1)
kplusg_evc(i,1) = CMPLX(0._DP,kplusgi,KIND=DP) * evc(i,ibnd)
IF ( ibnd < ibnd_end ) kplusg_evc(i,2) = CMPLX(0._DP,kplusgi,KIND=DP) * evc(i,ibnd+1)
ENDDO
!
ebnd = ibnd
@ -760,7 +760,7 @@ SUBROUTINE sum_band_gpu()
DO j=1,3
DO i = 1, npw
kplusgi = (xk(j,ik)+g(j,igk_k(i,ik))) * tpiba
kplusg_evc(i,1) = CMPLX(0.D0,kplusgi,kind=DP) * evc(i,ibnd)
kplusg_evc(i,1) = CMPLX(0._DP,kplusgi,KIND=DP) * evc(i,ibnd)
ENDDO
!
CALL wave_g2r( kplusg_evc(1:npw,1:1), psic, dffts, igk=igk_k(:,ik) )

4
PW/src/vhpsi_gpu.f90
View File

@ -127,11 +127,11 @@ SUBROUTINE vhpsi_U_gpu()
ALLOCATE( ctemp_d(ldimaxt,mps) )
IF (ANY(is_hubbard(:))) THEN
ALLOCATE( vaux_d(ldimax,ldimax,nat) )
vaux_d = CMPLX(v%ns(:,:,current_spin,:))
vaux_d = CMPLX(v%ns(:,:,current_spin,:),KIND=DP)
ENDIF
IF (ANY(is_hubbard_back(:))) THEN
ALLOCATE( vauxb_d(ldmx_b,ldmx_b,nat) )
vauxb_d = CMPLX(v%nsb(:,:,current_spin,:))
vauxb_d = CMPLX(v%nsb(:,:,current_spin,:),KIND=DP)
ENDIF
ENDIF
ENDIF

6
upflib/gen_us_dj.f90
View File

@ -23,7 +23,7 @@ SUBROUTINE gen_us_dj_base( npw, npwx, igk, xk, nat, tau, ityp, ntyp, tpiba, &
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: npw
!! number ok plane waves
!! number ok plane waves
INTEGER, INTENT(IN) :: npwx
!! max number ok plane waves across k-points
INTEGER, INTENT(IN) :: igk(npw)
@ -199,8 +199,8 @@ SUBROUTINE gen_us_dj_base( npw, npwx, igk, xk, nat, tau, ityp, ntyp, tpiba, &
lm = nhtolm(ih,nt)
pref = (0._DP,-1._DP)**l
!
dvkb(ig,ikb) = CMPLX(djl(ig,nb,nt)) * sk(ig,na) * &
CMPLX(ylm(ig,lm)) * pref
dvkb(ig,ikb) = CMPLX(djl(ig,nb,nt),KIND=DP) * sk(ig,na) * &
CMPLX(ylm(ig,lm),KIND=DP) * pref
ENDDO
ENDDO
!

10
upflib/gen_us_dy.f90
View File

@ -25,7 +25,7 @@ SUBROUTINE gen_us_dy_base( npw, npwx, igk, xk, nat, tau, ityp, ntyp, tpiba, &
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: npw
!! number ok plane waves
!! number ok plane waves
INTEGER, INTENT(IN) :: npwx
!! max number ok plane waves across k-points
INTEGER, INTENT(IN) :: igk(npw)
@ -180,7 +180,7 @@ SUBROUTINE gen_us_dy_base( npw, npwx, igk, xk, nat, tau, ityp, ntyp, tpiba, &
ENDDO
ENDDO
!
ALLOCATE( sk(npw,nat) )
!$acc data create( sk )
!
@ -238,10 +238,10 @@ SUBROUTINE gen_us_dy_base( npw, npwx, igk, xk, nat, tau, ityp, ntyp, tpiba, &
lm = nhtolm(ih,nt)
pref = (0._DP,-1._DP)**l
!
dvkb(ig,ikb) = CMPLX(vkb0(ig,nb,nt)) * sk(ig,na) * &
CMPLX(dylm_u(ig,lm)) * pref / CMPLX(tpiba)
dvkb(ig,ikb) = CMPLX(vkb0(ig,nb,nt),KIND=DP) * sk(ig,na) * &
CMPLX(dylm_u(ig,lm),KIND=DP) * pref / CMPLX(tpiba,KIND=DP)
ENDDO
ENDDO
ENDDO
!
!$acc end data
!$acc end data