More removal of zdotc - may or may not work (I think it will)

This commit is contained in:
Paolo Giannozzi 2020-07-12 10:16:22 +02:00
parent 8d74229e00
commit b315c97b00
3 changed files with 7 additions and 11 deletions

View File

@ -102,7 +102,6 @@ subroutine cgsolve_all (ch_psi, cg_psi, e, d0psi, dpsi, h_diag, &
complex(DP) :: dcgamma, dclambda
! the ratio between rho
! step length
complex(DP), external :: zdotc
REAL(kind=dp), EXTERNAL :: ddot
! the scalar product
real(DP), allocatable :: rho (:), rhoold (:), eu (:), a(:), c(:)
@ -168,7 +167,7 @@ subroutine cgsolve_all (ch_psi, cg_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, h(1,ibnd_), 1, g(1,ibnd_), 1)
rho(lbnd) = ddot (2*ndmx*npol, h(1,ibnd_), 1, g(1,ibnd_), 1)
ENDIF
endif
enddo
@ -232,8 +231,8 @@ subroutine cgsolve_all (ch_psi, cg_psi, e, d0psi, dpsi, h_diag, &
c(lbnd)=c(lbnd)-DBLE(h(1,ibnd_))*DBLE(t(1,lbnd))
ENDIF
ELSE
a(lbnd) = zdotc (ndmx*npol, h(1,ibnd_), 1, g(1,ibnd_), 1)
c(lbnd) = zdotc (ndmx*npol, h(1,ibnd_), 1, t(1,lbnd), 1)
a(lbnd) = ddot (2*ndmx*npol, h(1,ibnd_), 1, g(1,ibnd_), 1)
c(lbnd) = ddot (2*ndmx*npol, h(1,ibnd_), 1, t(1,lbnd), 1)
ENDIF
end if
end do

View File

@ -39,7 +39,6 @@ FUNCTION lr_dot(x,y)
REAL(kind=dp) :: temp_gamma, degspin
INTEGER :: ibnd, ik
REAL(kind=dp), EXTERNAL :: DDOT
COMPLEX(kind=dp), EXTERNAL :: ZDOTC
!
CALL start_clock ('lr_dot')
!
@ -120,7 +119,7 @@ CONTAINS
!
DO ibnd = 1, nbnd_occ(ikk)
!
lr_dot = lr_dot + wk(ikk) *ZDOTC(npwx*npol,x(1,ibnd,ik),1,y(1,ibnd,ik),1)
lr_dot = lr_dot + wk(ikk) * dot_product(x(:,ibnd,ik),y(:,ibnd,ik))
!
ENDDO
!
@ -156,7 +155,8 @@ CONTAINS
!
DO ibnd = 1, nbnd_occ(ikk)
!
lr_dot = lr_dot + wk(ikk) * ZDOTC(npwq,x(1,ibnd,ik),1,y(1,ibnd,ik),1)
lr_dot = lr_dot + wk(ikk) * &
dot_product( x(1:npwq,ibnd,ik), y(1:npwq,ibnd,ik) )
!
ENDDO
!

View File

@ -52,9 +52,6 @@ subroutine newdq (dvscf, npe)
! the values of q+G
! the spherical harmonics
complex(DP), external :: zdotc
! the scalar product function
complex(DP), allocatable :: aux1 (:), aux2 (:,:), veff (:), qgm(:)
! work space
@ -118,7 +115,7 @@ subroutine newdq (dvscf, npe)
enddo
do is = 1, nspin_mag
int3(ih,jh,na,is,ipert) = omega * &
zdotc(ngm,aux1,1,aux2(1,is),1)
dot_product(aux1(:),aux2(:,is))
enddo
endif
enddo