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

Merge branch 'zdotc' into 'develop' 

Some zdotc removal - PLEASE CHECK

See merge request QEF/q-e!1509
This commit is contained in:
Ye Luo 2021-07-20 14:15:57 +00:00
parent e7355d8739 b082742896
commit bacf2ae409
6 changed files with 29 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
KS_Solvers/ParO/pcg_k.f90
View File

@ -87,7 +87,6 @@ SUBROUTINE pcg_k( hs_1psi, g_1psi, psi0, spsi0, npw, npwx, nbnd, npol, psi, ethr
INTEGER :: kdim, kdmx, cg_iter, ibnd
!
REAL(DP), EXTERNAL :: DDOT
COMPLEX(DP), EXTERNAL :: ZDOTC
EXTERNAL hs_1psi, g_1psi
! hs_1psi( npwx, npw, psi, hpsi, spsi )
@ -115,7 +114,7 @@ SUBROUTINE pcg_k( hs_1psi, g_1psi, psi0, spsi0, npw, npwx, nbnd, npol, psi, ethr
CALL stop_clock( 'pcg:ortho' )
!-
g0 = ZDOTC( kdim, z ,1 ,r ,1)
g0 = DDOT( 2*kdim, z ,1 ,r ,1)
CALL mp_sum( g0, intra_bgrp_comm ) ! g0 = < initial z | initial r >
ff = 0.d0 ; ff0 = ff
@ -143,13 +142,13 @@ SUBROUTINE pcg_k( hs_1psi, g_1psi, psi0, spsi0, npw, npwx, nbnd, npol, psi, ethr
CALL stop_clock( 'pcg:hs_1psi' )
w = w - e* sp
gamma = ZDOTC( kdim, p ,1 ,w ,1)
gamma = DDOT( 2*kdim, p ,1 ,w ,1)
CALL mp_sum( gamma, intra_bgrp_comm )
alpha = g0/gamma
psi(:) = psi(:) + alpha * p(:) ! updated solution
r(:) = r(:) - alpha * w(:) ! updated gradient
g2 = ZDOTC( kdim, z ,1 ,r ,1)
g2 = DDOT ( 2*kdim, z ,1 ,r ,1)
CALL mp_sum( g2, intra_bgrp_comm ) ! g2 = < old z | new r >
z(:) = r(:) ; call g_1psi(npwx,npw,z,e) ! updated preconditioned gradient
!- project on conduction bands
@ -159,10 +158,10 @@ SUBROUTINE pcg_k( hs_1psi, g_1psi, psi0, spsi0, npw, npwx, nbnd, npol, psi, ethr
CALL ZGEMV( 'N', kdim, nbnd, (-1.D0,0.D0), psi0, kdmx, spsi0vec, 1, ONE, z, 1 )
CALL stop_clock( 'pcg:ortho' )
!-
g1 = ZDOTC( kdim, z, 1, r ,1)
g1 = DDOT ( 2*kdim, z, 1, r ,1)
CALL mp_sum( g1, intra_bgrp_comm ) ! g1 = < new z | new r >
! evaluate the function
ff = - 0.5_DP * (ZDOTC( kdim, psi, 1, r ,1) + ZDOTC( kdim, psi, 1, b ,1) )
ff = - 0.5_DP * (DDOT(2*kdim, psi, 1, r ,1) + DDOT(2*kdim, psi, 1, b ,1) )
CALL mp_sum( ff, intra_bgrp_comm )
!write (6,*) cg_iter, g1, ff, gamma
if ( ff > ff0 .AND. ff0 < 0.d0 ) psi(:) = psi(:) - alpha * p(:) ! fallback solution if last iteration failed to improve the function... exit and hope next time it'll be better

7
LR_Modules/ccgsolve_all.f90
View File

@ -103,7 +103,6 @@ subroutine ccgsolve_all (ch_psi, ccg_psi, e, d0psi, dpsi, h_diag, &
complex(DP) :: dcgamma, dcgamma1, dclambda, dclambda1
! the ratio between rho
! step length
complex(DP), external :: zdotc
REAL(kind=dp), EXTERNAL :: ddot
! the scalar product
real(DP), allocatable :: eu (:)
@ -194,7 +193,7 @@ subroutine ccgsolve_all (ch_psi, ccg_psi, e, d0psi, dpsi, h_diag, &
rho(lbnd)=rho(lbnd)-DBLE(h(1,ibnd_))*DBLE(g(1,ibnd_))
ENDIF
ELSE
rho(lbnd) = zdotc (ndmx*npol, hs(1,ibnd_), 1, g(1,ibnd_), 1)
rho(lbnd) = dot_product (hs(:,ibnd_), g(:,ibnd_))
ENDIF
endif
@ -279,8 +278,8 @@ subroutine ccgsolve_all (ch_psi, ccg_psi, e, d0psi, dpsi, h_diag, &
ENDIF
ELSE
a(lbnd) = zdotc (ndmx*npol, hs(1,ibnd_), 1, g(1,ibnd_), 1)
c(lbnd) = zdotc (ndmx*npol, hs(1,ibnd_), 1, t(1,lbnd), 1)
a(lbnd) = dot_product (hs(:,ibnd_), g(:,ibnd_))
c(lbnd) = dot_product (hs(:,ibnd_), t(:,lbnd))
ENDIF

18
LR_Modules/lr_dot_magnons.f90
View File

@ -1,5 +1,5 @@
!
! Copyright (C) 2001-2016 Quantum ESPRESSO group
! Copyright (C) 2021 Quantum ESPRESSO group
! This file is distributed under the terms of the
! GNU General Public License. See the file `License'
! in the root directory of the present distribution,
@ -9,13 +9,7 @@
FUNCTION lr_dot_magnons(x,y)
!---------------------------------------------------------------------
!
! This subroutine calculates a dot product of the conjugate
! of a complex vector x and a complex vector y
! (sums over the bands and k-points).
!
! Brent Walker, ICTP, 2004
! Modified by Osman Baris Malcioglu, SISSA, 2009
! Modified by Iurii Timrov, SISSA, 2013 (extension to EELS)
! Extension of lr_dot.f90 to magnons
!
USE kinds, ONLY : dp
USE io_global, ONLY : stdout
@ -38,8 +32,6 @@ FUNCTION lr_dot_magnons(x,y)
COMPLEX(kind=dp) :: lr_dot_magnons
REAL(kind=dp) :: degspin
INTEGER :: ibnd, ik
REAL(kind=dp), EXTERNAL :: DDOT
COMPLEX(kind=dp), EXTERNAL :: ZDOTC
!
CALL start_clock ('lr_dot_magnons')
!
@ -93,7 +85,8 @@ CONTAINS
!
DO ibnd = 1, nbnd_occ(ikk)
!
lr_dot_magnons = lr_dot_magnons + wk(ikk) * ZDOTC(npwx*npol,x(1,ibnd,ik,1),1,y(1,ibnd,ik,1),1)
lr_dot_magnons = lr_dot_magnons + wk(ikk) * &
dot_product(x(:,ibnd,ik,1),y(:,ibnd,ik,1))
!
ENDDO
!
@ -101,7 +94,8 @@ CONTAINS
!
DO ibnd = 1, nbnd_occ(imk)
!
lr_dot_magnons = lr_dot_magnons + wk(imk) * ZDOTC(npwx*npol,x(1,ibnd,ik,2),1,y(1,ibnd,ik,2),1)
lr_dot_magnons = lr_dot_magnons + wk(imk) * &
dot_product(x(:,ibnd,ik,1),y(:,ibnd,ik,2))
!
ENDDO
!

4
Makefile
View File

@ -355,10 +355,10 @@ tar-qe-modes :
# "latex2html" and "convert" (from Image-Magick) are needed.
doc :
if test -d Doc ; then \
( cd Doc ; $(MAKE) VERSION=6.6 TLDEPS= all ) ; fi
( cd Doc ; $(MAKE) TLDEPS= all ) ; fi
for dir in */Doc; do \
( if test -f $$dir/Makefile ; then \
( cd $$dir; $(MAKE) VERSION=6.6 TLDEPS= all ) ; fi ) ; done
( cd $$dir; $(MAKE) TLDEPS= all ) ; fi ) ; done
doc_clean :
if test -d Doc ; then \

20
PW/src/commutator_Vhubx_psi.f90
View File

@ -68,8 +68,6 @@ SUBROUTINE commutator_Vhubx_psi(ik, nbnd_calc, vpol, dpsi)
dpqq26(:,:), dpqq38(:,:), dpqq47(:,:), dkvkbbessel(:,:), &
dkvkbylmr(:,:), dkvkb(:,:), aux_1234(:), termi(:,:), trm(:,:), &
wfcatomk(:,:), swfcatomk(:,:), proj1(:,:), proj2(:,:), proj3(:,:)
COMPLEX(DP), EXTERNAL :: zdotc
!
CALL start_clock( 'commutator_Vhubx_psi' )
!
! Number of plane waves at point ik
@ -218,14 +216,17 @@ SUBROUTINE commutator_Vhubx_psi(ik, nbnd_calc, vpol, dpsi)
! the same holds for 3 and 8, 4 and 7
! Note: these are the notations from private notes of A. Floris
!
! FIXME: compute all dpqqNN in vecqqproj, not just one
! FIXME: replace dot_product calls with matrix-matrix products
!
CALL vecqqproj (npw, vkb, vkb, dkwfcatomk(:,ihubst), dpqq26(:,ihubst))
CALL vecqqproj (npw, dkvkb, vkb, wfcatomk(:,ihubst), dpqq38(:,ihubst))
CALL vecqqproj (npw, vkb, dkvkb, wfcatomk(:,ihubst), dpqq47(:,ihubst))
!
DO ibnd = 1, nbnd_calc
proj3(ibnd,ihubst) = zdotc (npw, dpqq26(:,ihubst), 1, evc(:,ibnd), 1) + &
zdotc (npw, dpqq47(:,ihubst), 1, evc(:,ibnd), 1) + &
zdotc (npw, dpqq38(:,ihubst), 1, evc(:,ibnd), 1)
proj3(ibnd,ihubst) = &
dot_product (dpqq26(1:npw,ihubst), evc(1:npw,ibnd)) + &
dot_product (dpqq47(1:npw,ihubst), evc(1:npw,ibnd)) + &
dot_product (dpqq38(1:npw,ihubst), evc(1:npw,ibnd))
ENDDO
!
ENDIF
@ -235,8 +236,8 @@ SUBROUTINE commutator_Vhubx_psi(ik, nbnd_calc, vpol, dpsi)
! Calculate proj (ihubst,ibnd) = < S_{k}\phi_(k,I,m)| psi(ibnd,ik) >
! at ihubst (i.e. I, m).
!
proj1(ibnd,ihubst) = zdotc (npw, swfcatomk(:,ihubst), 1, evc(:,ibnd), 1)
proj2(ibnd,ihubst) = zdotc (npw, dkwfcatomk(:,ihubst), 1, evc(:,ibnd), 1)
proj1(ibnd,ihubst) = dot_product (swfcatomk(1:npw,ihubst), evc(1:npw,ibnd))
proj2(ibnd,ihubst) = dot_product (dkwfcatomk(1:npw,ihubst), evc(1:npw,ibnd))
!
ENDDO
!
@ -429,7 +430,6 @@ SUBROUTINE vecqqproj (npw, vec1, vec2, vec3, dpqq)
INTEGER :: na, nt, l1, l2, ig, ibeta1, ibeta2, ibnd
COMPLEX(DP), ALLOCATABLE :: aux1(:)
COMPLEX(DP) :: projaux1vec3
COMPLEX(DP), EXTERNAL :: zdotc
!
dpqq = (0.d0, 0.d0)
!
@ -452,7 +452,7 @@ SUBROUTINE vecqqproj (npw, vec1, vec2, vec3, dpqq)
aux1(:) = aux1(:) + qq_nt(l1,l2,nt) * vec2(:,ibeta2)
ENDDO
!
projaux1vec3 = zdotc (npw, aux1, 1, vec3, 1)
projaux1vec3 = dot_product (aux1(1:npw), vec3(1:npw))
!
CALL mp_sum(projaux1vec3, intra_pool_comm)
!

6
QEHeat/Doc/Makefile
View File

@ -67,6 +67,6 @@ INPUT_ALL_CURRENTS.txt: %.txt: %.def input_xx.xsl
$(HELPDOC) $<
link_on_main_doc:
-@( cd ../../Doc ; ln -fs ../PW/Doc/INPUT_ALL_CURRENTS.html . ; \
ln -fs ../PW/Doc/INPUT_ALL_CURRENTS.xml . ; \
ln -fs ../PW/Doc/INPUT_ALL_CURRENTS.txt .)
-@( cd ../../Doc ; ln -fs ../QEHEAT/Doc/INPUT_ALL_CURRENTS.html . ; \
ln -fs ../QEHEAT/Doc/INPUT_ALL_CURRENTS.xml . ; \
ln -fs ../QEHEAT/Doc/INPUT_ALL_CURRENTS.txt .)