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

- bug fix: Lapack DSPEV was used even when ESSL were used 

- Same gram subroutine both for CP and FPMD subroutines
- simpson_fpmd everywhere substituted with simpson_cp90


git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@2572 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
cavazzon 2005-12-09 11:13:40 +00:00
parent 1cb5b95829
commit b0a174982d
16 changed files with 163 additions and 360 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
CPV/cg_sub.f90
View File

@ -127,7 +127,7 @@
call calbec(1,nsp,eigr,c0,bec)
call gram(betae,bec,c0)
call gram(betae,bec,nhsa,c0,ngw,n)
call calbec(1,nsp,eigr,c0,bec)
@ -449,7 +449,7 @@
!orthonormalize
call calbec(1,nsp,eigr,cm,becm)
call gram(betae,becm,cm)
call gram(betae,becm,nhsa,cm,ngw,n)
call calbec(1,nsp,eigr,cm,becm)
!calculate energy
@ -502,7 +502,7 @@
endif
call calbec(1,nsp,eigr,cm,becm)
call gram(betae,becm,cm)
call gram(betae,becm,nhsa,cm,ngw,n)
!test on energy: check the energy has really diminished
@ -559,7 +559,7 @@
c0(1:ngw,1:n,1,1)=c0(1:ngw,1:n,1,1)+spasso*passov*hi(1:ngw,1:n)
restartcg=.true.!ATTENZIONE
call calbec(1,nsp,eigr,c0,bec)
call gram(betae,bec,c0)
call gram(betae,bec,nhsa,c0,ngw,n)
!if ene > ene0,en1 do a steepest descent step
ene_ok=.false.
else if((enever.ge.ene0).and.(ene0.le.ene1)) then
@ -575,7 +575,7 @@
! chenge the searching direction
spasso=spasso*(-1.d0)
call calbec(1,nsp,eigr,cm,becm)
call gram(betae,bec,cm)
call gram(betae,bec,nhsa,cm,ngw,n)
call calbec(1,nsp,eigr,cm,becm)
if(.not.tens) then
call rhoofr(nfi,cm,irb,eigrb,becm,rhovan,rhor,rhog,rhos,enl,ekin)

4
CPV/cglib.f90
View File

@ -175,6 +175,7 @@
subroutine ddiag(nx,n,amat,dval,dvec,iflag)
!-----------------------------------------------------------------------
!
use parallel_toolkit, only: dspev_drv
implicit none
integer nx,n,naux,ndim,iopt,iflag,k,i,j,info
real(8) dval(n)
@ -208,7 +209,8 @@
end do
end do
call dspev('V','U',n,ap,dval,dvec,nx,aux,info)
CALL dspev_drv( 'V', 'U', n, ap, dval, dvec, nx )
if(info.ne.0) write(6,*) 'Problems with ddiag'
deallocate(ap)

132
CPV/cplib.f90
View File

@ -329,23 +329,24 @@
RETURN
END SUBROUTINE calphi
!-----------------------------------------------------------------------
REAL(8) FUNCTION cscnorm(bec,cp,i)
REAL(8) FUNCTION cscnorm( bec, nkbx, cp, ngwx, i, n )
!-----------------------------------------------------------------------
! requires in input the updated bec(i)
!
USE ions_base, ONLY: na
USE gvecw, ONLY: ngw
USE ions_base, ONLY: na
USE gvecw, ONLY: ngw
USE reciprocal_vectors, ONLY: gstart
USE electrons_base, ONLY: n => nbsp
USE cvan, ONLY: ish, nvb
USE cvan, ONLY: ish, nvb
USE uspp_param, ONLY: nh
USE uspp, ONLY: nhsa=>nkb, nhsavb=>nkbus, qq
USE mp, ONLY: mp_sum
USE uspp, ONLY: qq
USE mp, ONLY: mp_sum
USE kinds, ONLY: DP
!
IMPLICIT NONE
INTEGER i
REAL(8) bec(nhsa,n)
COMPLEX(8) cp(ngw,n)
INTEGER, INTENT(IN) :: i, n
INTEGER, INTENT(IN) :: ngwx, nkbx
REAL(DP) :: bec( nkbx, n )
COMPLEX(DP) :: cp( ngwx, n )
!
INTEGER ig, is, iv, jv, ia, inl, jnl
REAL(8) rsum
@ -1441,48 +1442,54 @@
!
!-------------------------------------------------------------------------
SUBROUTINE gracsc(bec,betae,cp,i,csc)
SUBROUTINE gracsc( bec, nkbx, betae, cp, ngwx, i, csc, n )
!-----------------------------------------------------------------------
! requires in input the updated bec(k) for k<i
! on output: bec(i) is recalculated
!
USE ions_base, ONLY: na
USE cvan, ONLY :nvb, ish
USE uspp, ONLY :nhsa=>nkb, nhsavb=>nkbus, qq
USE uspp_param, ONLY: nh
USE electrons_base, ONLY: n => nbsp, ispin => fspin, nx => nbspx
USE gvecw, ONLY: ngw
USE ions_base, ONLY: na
USE cvan, ONLY :nvb, ish
USE uspp, ONLY : nkb, nhsavb=>nkbus, qq
USE uspp_param, ONLY: nh
USE electrons_base, ONLY: ispin => fspin
USE gvecw, ONLY: ngw
USE mp, ONLY: mp_sum
USE kinds, ONLY: DP
USE reciprocal_vectors, ONLY: gstart
USE mp, ONLY: mp_sum
!
IMPLICIT NONE
!
INTEGER i
COMPLEX(8) betae(ngw,nhsa)
REAL(8) bec(nhsa,n), cp(2,ngw,n)
REAL(8) csc(nx)
INTEGER k, kmax,ig, is, iv, jv, ia, inl, jnl
REAL(8) rsum, temp(ngw) ! automatic array
!
! calculate csc(k)=<cp(i)|cp(k)>, k<i
!
kmax=i-1
DO k=1,kmax
csc(k)=0.
IF (ispin(i).EQ.ispin(k)) THEN
DO ig=1,ngw
temp(ig)=cp(1,ig,k)*cp(1,ig,i)+cp(2,ig,k)*cp(2,ig,i)
INTEGER, INTENT(IN) :: i, nkbx, ngwx, n
COMPLEX(DP) :: betae( ngwx, nkb )
REAL(DP) :: bec( nkbx, n ), cp( 2, ngwx, n )
REAL(DP) :: csc( n )
INTEGER :: k, kmax,ig, is, iv, jv, ia, inl, jnl
REAL(DP) :: rsum
REAL(DP), ALLOCATABLE :: temp(:)
!
! calculate csc(k)=<cp(i)|cp(k)>, k<i
!
ALLOCATE( temp( ngw ) )
kmax = i - 1
DO k = 1, kmax
csc(k) = 0.0d0
IF ( ispin(i) .EQ. ispin(k) ) THEN
DO ig = 1, ngw
temp(ig) = cp(1,ig,k) * cp(1,ig,i) + cp(2,ig,k) * cp(2,ig,i)
END DO
csc(k)=2.*SUM(temp)
IF (gstart == 2) csc(k)=csc(k)-temp(1)
csc(k) = 2.0d0 * SUM(temp)
IF (gstart == 2) csc(k) = csc(k) - temp(1)
ENDIF
END DO
CALL mp_sum( csc( 1:kmax ) )
!
! calculate bec(i)=<cp(i)|beta>
!
!
! calculate bec(i)=<cp(i)|beta>
!
DO inl=1,nhsavb
DO ig=1,ngw
temp(ig)=cp(1,ig,i)* DBLE(betae(ig,inl))+ &
@ -1525,46 +1532,51 @@
bec(inl,i)=bec(inl,i)-csc(k)*bec(inl,k)
END DO
END DO
DEALLOCATE( temp )
!
RETURN
END SUBROUTINE gracsc
!-------------------------------------------------------------------------
SUBROUTINE gram(betae,bec,cp)
SUBROUTINE gram( betae, bec, nkbx, cp, ngwx, n )
!-----------------------------------------------------------------------
! gram-schmidt orthogonalization of the set of wavefunctions cp
!
USE uspp, ONLY :nhsa=>nkb, nhsavb=> nkbus
USE electrons_base, ONLY: nx => nbspx, n => nbsp
USE gvecw, ONLY: ngw
USE uspp, ONLY : nkb, nhsavb=> nkbus
USE gvecw, ONLY : ngw
USE kinds, ONLY : DP
!
IMPLICIT NONE
!
REAL(8) bec(nhsa,n)
COMPLEX(8) cp(ngw,n), betae(ngw,nhsa)
INTEGER, INTENT(IN) :: nkbx, ngwx, n
REAL(DP) :: bec( nkbx, n )
COMPLEX(DP) :: cp( ngwx, n ), betae( ngwx, nkb )
!
REAL(8) :: anorm, cscnorm
REAL(8), ALLOCATABLE :: csc( : )
REAL(DP) :: anorm, cscnorm
REAL(DP), ALLOCATABLE :: csc( : )
INTEGER :: i,k
EXTERNAL cscnorm
!
CALL start_clock( 'gram' )
ALLOCATE( csc( nx ) )
ALLOCATE( csc( n ) )
!
DO i=1,n
CALL gracsc(bec,betae,cp,i,csc)
!
! calculate orthogonalized cp(i) : |cp(i)>=|cp(i)>-\sum_k<i csc(k)|cp(k)>
!
DO k=1,i-1
CALL DAXPY(2*ngw,-csc(k),cp(1,k),1,cp(1,i),1)
DO i = 1, n
!
CALL gracsc( bec, nkbx, betae, cp, ngwx, i, csc, n )
!
! calculate orthogonalized cp(i) : |cp(i)>=|cp(i)>-\sum_k<i csc(k)|cp(k)>
!
DO k = 1, i - 1
CALL DAXPY( 2*ngw, -csc(k), cp(1,k), 1, cp(1,i), 1 )
END DO
anorm =cscnorm(bec,cp,i)
CALL DSCAL(2*ngw,1.0/anorm,cp(1,i),1)
!
! these are the final bec's
!
CALL DSCAL(nhsavb,1.0/anorm,bec(1,i),1)
anorm = cscnorm( bec, nkbx, cp, ngwx, i, n )
CALL DSCAL( 2*ngw, 1.0/anorm, cp(1,i), 1 )
!
! these are the final bec's
!
CALL DSCAL( nhsavb, 1.0/anorm, bec(1,i), 1 )
END DO
!
DEALLOCATE( csc )

2
CPV/cpr.f90
View File

@ -397,7 +397,7 @@ SUBROUTINE cprmain( tau, fion_out, etot_out )
!
ELSE
!
CALL gram( vkb, bec,cm )
CALL gram( vkb, bec, nkb, cm, ngw, nbsp )
!
IF ( iprsta > 4 ) CALL dotcsc( eigr, cm )
!

19
CPV/fromscra.f90
View File

@ -32,7 +32,7 @@ MODULE from_scratch_module
!
USE kinds, ONLY : DP
USE wave_types, ONLY : wave_descriptor
USE wave_functions, ONLY : gram, fixwave, wave_rand_init
USE wave_functions, ONLY : fixwave, wave_rand_init
USE wave_base, ONLY : wave_steepest
USE charge_density, ONLY : rhoofr
USE cell_module, only : boxdimensions
@ -54,6 +54,7 @@ MODULE from_scratch_module
USE gvecp, ONLY : ngm
USE io_global, ONLY : ionode, stdout
USE parameters, ONLY : nacx
USE uspp, ONLY : vkb, nkb
!
USE atoms_type_module, ONLY : atoms_type
USE phase_factors_module, ONLY : strucf, phfacs
@ -136,7 +137,11 @@ MODULE from_scratch_module
IF ( ionode ) &
WRITE( stdout, fmt = '(//,3X, "Wave Initialization: random initial wave-functions" )' )
!
CALL gram( cm, cdesc )
DO iss = 1, nspin_wfc
!
CALL gram( vkb, bec, nkb, cm(1,1,1,iss), SIZE(cm,1), cdesc%nbt( iss ) )
!
END DO
!
c0 = cm
!
@ -180,7 +185,11 @@ MODULE from_scratch_module
!
ELSE
!
CALL gram( c0, cdesc )
DO iss = 1, nspin_wfc
!
CALL gram( vkb, bec, nkb, c0(1,1,1,iss), SIZE(c0,1), cdesc%nbt( iss ) )
!
END DO
!
END IF
!
@ -309,7 +318,7 @@ MODULE from_scratch_module
!
CALL prefor( eigr, vkb )
!
CALL gram( vkb, bec, cm )
CALL gram( vkb, bec, nkb, cm, ngw, nbsp )
if( iprsta .ge. 3 ) CALL dotcsc( eigr, cm )
@ -380,7 +389,7 @@ MODULE from_scratch_module
if( tortho ) then
CALL ortho( eigr, c0, phi, lambda, bigr, iter, ccc, ortho_eps, ortho_max, delt, bephi, becp )
else
CALL gram( vkb, bec, c0 )
CALL gram( vkb, bec, nkb, c0, ngw, nbsp )
endif
!
!

15
CPV/guess.f90
View File

@ -69,23 +69,24 @@
! ----------------------------------------------
! ----------------------------------------------
SUBROUTINE guessc0( tk, c0, cm, cdesc )
SUBROUTINE guessc0( tk, bec, c0, cm, cdesc )
! this subroutine updates the wavefunctions, leaving the new wave
! functions in the KS base
! ----------------------------------------------
! ... declare modules
USE mp
USE wave_functions, ONLY: gram
USE wave_types
USE control_flags, ONLY: force_pairing
USE mp_global, ONLY : nproc, mpime, group
USE wave_types, ONLY : wave_descriptor
USE control_flags, ONLY : force_pairing
USE uspp, ONLY : vkb, nkb
IMPLICIT NONE
! ... declare subroutine arguments
COMPLEX(DP), INTENT(INOUT) :: c0(:,:,:,:)
COMPLEX(DP), INTENT(INOUT) :: cm(:,:,:,:)
REAL(DP), INTENT(INOUT) :: bec(:,:)
TYPE (wave_descriptor), INTENT(IN) :: cdesc
LOGICAL, INTENT(IN) :: tk
@ -111,12 +112,10 @@
REAL(DP) costemp( cdesc%ngwl )
INTEGER jl, i,j,k,ig,h,n,ngw,nrl,ik,nk
INTEGER nproc,mpime,gid
! ... end of declarations
! ----------------------------------------------
CALL mp_env(nproc,mpime,gid)
IF( force_pairing ) &
CALL errore( ' guess ', ' force_pairing not yet implemented ', 1 )
@ -239,7 +238,7 @@
END IF
CALL gram( c0, cdesc )
CALL gram( vkb, bec, nkb, c0(1,1,1,1), SIZE(c0,1), cdesc%nbt( 1 ) )
RETURN
END SUBROUTINE guessc0

18
CPV/pseudo_base.f90
View File

@ -87,9 +87,8 @@
DO l = 1,nbeta
! ... G=0 (Only if l=1, since otherwise the radial Bessel function jl=0)
IF( ap%lll(l) == 0 ) THEN
fint(1:mmax,l) = ap%rw(1:mmax)**2 * ap%vrps(1:mmax,l)
call simpson_fpmd(mmax, fint(:,l), dx, wnl(ig,l))
! call simpson(mmax, fint(:,l), ap%rab, wnl(ig,l))
fint(1:mmax,l) = ap%rw(1:mmax) * ap%vrps(1:mmax,l)
call simpson_cp90( mmax, fint(1,l), ap%rab(1), wnl(ig,l) )
ELSE
wnl(ig,l) = 0.d0
END IF
@ -99,9 +98,8 @@
xg = SQRT( hg(ig) ) * tpiba
CALL bessel2(xg, ap%rw, fint, nbeta, ap%lll, mmax)
DO l = 1, nbeta
fint(1:mmax,l) = fint(1:mmax,l) * ap%rw(1:mmax)**2 * ap%vrps(1:mmax,l)
call simpson_fpmd(mmax, fint(:,l), dx, wnl(ig,l))
! call simpson(mmax, fint(:,l), ap%rab, wnl(ig,l))
fint(1:mmax,l) = fint(1:mmax,l) * ap%rw(1:mmax) * ap%vrps(1:mmax,l)
call simpson_cp90( mmax, fint(1,l), ap%rab(1), wnl(ig,l) )
END DO
! ... Bessel Test
@ -151,8 +149,8 @@
! ... G=0 (Only if L = 0, since otherwise the radial Bessel function JL=0)
DO l = 1, nbeta
IF( ap%lll(l) == 0 ) THEN
fint(1:mmax,l) = ap%rw(1:mmax)**2 * ap%vrps(1:mmax,l)
call simpson_fpmd(mmax, fint(:,l), dx, wnla(ig, l))
fint(1:mmax,l) = ap%rw(1:mmax) * ap%vrps(1:mmax,l)
call simpson_cp90( mmax, fint(1,l), ap%rab(1), wnla(ig,l) )
ELSE
wnla(ig, l) = 0.d0
END IF
@ -161,8 +159,8 @@
xg = SQRT(hg(ig)) * tpiba
CALL bessel3(xg, ap%rw, fint, nbeta, ap%lll, mmax)
DO l = 1, nbeta
fint(1:mmax,l) = fint(1:mmax,l) * ap%rw(1:mmax)**2 * ap%vrps(1:mmax,l)
call simpson_fpmd(mmax, fint(:,l), dx, wnla(ig,l))
fint(1:mmax,l) = fint(1:mmax,l) * ap%rw(1:mmax) * ap%vrps(1:mmax,l)
call simpson_cp90( mmax, fint(1,l), ap%rab(1), wnla(ig,l) )
END DO
END IF
END DO

1
CPV/restart.f90
View File

@ -340,7 +340,6 @@
USE ions_base, ONLY: nat, nsp, na
USE electrons_module, ONLY: nspin
USE control_flags, ONLY: twfcollect, force_pairing
USE wave_functions, ONLY: gram
USE grid_dimensions, ONLY: nr1, nr2, nr3
USE electrons_nose, ONLY: xnhe0, xnhem, vnhe
USE cell_nose, ONLY: xnhh0, xnhhm, vnhh

27
CPV/restart_sub.f90
View File

@ -142,7 +142,7 @@ MODULE from_restart_module
IF ( trane .AND. trhor ) THEN
!
CALL prefor( eigr, vkb )
CALL gram( vkb, bec, c0 )
CALL gram( vkb, bec, nkb, c0, ngw, nbsp )
!
cm(:,1:nbsp,1,1) = c0(:,1:nbsp,1,1)
!
@ -259,7 +259,7 @@ MODULE from_restart_module
!
ELSE
!
IF( .not. tcg) CALL gram( vkb, bec, cm )
IF( .not. tcg) CALL gram( vkb, bec, nkb, cm, ngw, nbsp )
!
END IF
!
@ -382,7 +382,7 @@ MODULE from_restart_module
!
CALL prefor( eigr, vkb )
!
CALL gram( vkb, bec, c0 )
CALL gram( vkb, bec, nkb, c0, ngw, nbsp )
!
cm(:,1:nbsp) = c0(:,1:nbsp)
!
@ -426,8 +426,8 @@ MODULE from_restart_module
USE phase_factors_module, ONLY : strucf, phfacs
USE time_step, ONLY : delt
USE charge_density, ONLY : rhoofr
USE wave_functions, ONLY : gram, rande, fixwave
USE wave_base, ONLY : wave_verlet
USE wave_functions, ONLY : fixwave
USE wave_base, ONLY : wave_verlet, rande_base
USE electrons_module, ONLY : pmss,emass, nspin, occn_info
USE ions_base, ONLY : na, nsp, nax, randpos, taui, cdmi
USE ions_module, ONLY : set_reference_positions, &
@ -461,6 +461,7 @@ MODULE from_restart_module
USE reciprocal_vectors, ONLY : mill_l
USE gvecp, ONLY : ngm
USE ions_base, ONLY : nat, tau_srt
USE uspp, ONLY : vkb, nkb
!
IMPLICIT NONE
!
@ -483,7 +484,7 @@ MODULE from_restart_module
REAL(DP) :: vpot(:,:,:,:)
TYPE(dft_energy_type) :: edft
!
INTEGER :: ig, ib, i, j, k, ik, nb, is, ia, ierr, isa
INTEGER :: ig, ib, i, j, k, ik, nb, is, ia, ierr, isa, iss
REAL(DP) :: timepre, vdum = 0.D0
REAL(DP) :: stau(3), rtau(3), hinv(3,3)
COMPLEX(DP) :: cgam(1,1,1)
@ -580,8 +581,12 @@ MODULE from_restart_module
!
WRITE( stdout, 515 ) ampre
!
CALL rande( c0, cdesc, ampre )
CALL rande( cm, cdesc, ampre )
DO iss = 1, cdesc%nspin
call rande_base( c0( :, :, 1, iss), ampre )
CALL gram( vkb, bec, nkb, c0(1,1,1,iss), SIZE(c0,1), cdesc%nbt( iss ) )
call rande_base( cm( :, :, 1, iss), ampre )
CALL gram( vkb, bec, nkb, cm(1,1,1,iss), SIZE(cm,1), cdesc%nbt( iss ) )
END DO
!
END IF
!
@ -651,7 +656,11 @@ MODULE from_restart_module
!
ELSE
!
CALL gram( c0, cdesc )
DO iss = 1, nspin
!
CALL gram( vkb, bec, nkb, c0(1,1,1,iss), SIZE(c0,1), cdesc%nbt( iss ) )
!
END DO
!
END IF
!

18
CPV/runcg.f90
View File

@ -67,7 +67,7 @@
USE electrons_module, ONLY: pmss, eigs, nb_l
USE cp_electronic_mass, ONLY: emass
USE descriptors_module, ONLY: get_local_dims, owner_of, local_index
USE wave_functions, ONLY: gram, rande, cp_kinetic_energy, proj, fixwave
USE wave_functions, ONLY: cp_kinetic_energy, proj, fixwave
USE wave_base, ONLY: dotp, hpsi
USE wave_constrains, ONLY: update_lambda
USE check_stop, ONLY: check_stop_now
@ -84,6 +84,7 @@
USE control_flags, ONLY: force_pairing
USE environment, ONLY: start_cclock_val
USE reciprocal_space_mesh, ONLY: gkmask_l
USE uspp, ONLY : vkb, nkb
IMPLICIT NONE
@ -258,7 +259,9 @@
IF( tortho ) THEN
CALL ortho( c0, cp, cdesc, pmss, emass )
ELSE
CALL gram( cp, cdesc )
DO ispin = 1, nspin
CALL gram( vkb, bec, nkb, cp(1,1,1,ispin), SIZE(cp,1), cdesc%nbt( ispin ) )
END DO
END IF
END IF
@ -367,7 +370,7 @@
USE wave_types
USE energies, ONLY: dft_energy_type
USE wave_functions, ONLY: gram, fixwave
USE wave_functions, ONLY: fixwave
USE io_global, ONLY: ionode
USE io_global, ONLY: stdout
USE cell_module, ONLY: boxdimensions
@ -375,6 +378,7 @@
USE atoms_type_module, ONLY: atoms_type
USE charge_types, ONLY: charge_descriptor
USE reciprocal_space_mesh, ONLY: gkmask_l
USE uspp, ONLY : vkb, nkb
IMPLICIT NONE
@ -413,7 +417,7 @@
REAL(DP) :: x, p, v, w, e, fw, fv, xm, tol1, tol2, a, b, etemp, d
REAL(DP) :: fx, xmin, brent, eold, tol
LOGICAL :: tbrent
INTEGER :: iter
INTEGER :: iter, ispin
!
! ... SUBROUTINE BODY
@ -595,7 +599,11 @@
cp = c + hstep * hacca
CALL fixwave( cp, cdesc, gkmask_l )
CALL gram( cp, cdesc )
DO ispin = 1, cdesc%nspin
CALL gram( vkb, bec, nkb, cp(1,1,1,ispin), SIZE(cp,1), cdesc%nbt( ispin ) )
END DO
CALL kspotential( 1, ttprint, ttforce, ttstress, rhoe, desc, &
atoms, bec, becdr, eigr, ei1, ei2, ei3, sfac, cp, cdesc, tcel, ht, occ, vpot, edft, timepre )

2
CPV/runcg_ion.f90
View File

@ -296,7 +296,7 @@
USE wave_types, ONLY: wave_descriptor
USE energies, ONLY: dft_energy_type
USE wave_functions, ONLY: gram, update_wave_functions
USE wave_functions, ONLY: update_wave_functions
USE io_global, ONLY: ionode
USE io_global, ONLY: stdout
USE cell_module, ONLY: boxdimensions, r_to_s

16
CPV/runcp.f90
View File

@ -45,7 +45,7 @@
USE electrons_module, ONLY: pmss, eigs, nb_l
USE cp_electronic_mass, ONLY: emass
USE descriptors_module, ONLY: get_local_dims, owner_of, local_index
USE wave_functions, ONLY : rande, cp_kinetic_energy, gram
USE wave_functions, ONLY : cp_kinetic_energy
USE wave_base, ONLY : frice
USE wave_base, ONLY: hpsi
USE cell_module, ONLY: boxdimensions
@ -58,6 +58,7 @@
USE control_flags, ONLY: tdamp
USE wave_constrains, ONLY: update_lambda
USE reciprocal_space_mesh, ONLY: gkmask_l
USE uspp, ONLY : vkb, nkb
IMPLICIT NONE
@ -126,9 +127,11 @@
! Orthogonalize the new wave functions "cp"
IF( tortho ) THEN
CALL ortho(c0, cp, cdesc, pmss, emass)
CALL ortho(c0, cp, cdesc, pmss, emass)
ELSE
CALL gram(cp, cdesc)
DO is = 1, cdesc%nspin
CALL gram( vkb, bec, nkb, cp(1,1,1,is), SIZE(cp,1), cdesc%nbt( is ) )
END DO
END IF
s3 = cclock()
@ -355,7 +358,7 @@
USE electrons_module, ONLY: pmss, eigs, nb_l, nupdwn, nspin
USE cp_electronic_mass, ONLY: emass
USE descriptors_module, ONLY: get_local_dims, owner_of, local_index
USE wave_functions, ONLY : rande, cp_kinetic_energy, gram
USE wave_functions, ONLY : cp_kinetic_energy
USE wave_base, ONLY: frice, wave_steepest, wave_verlet
USE wave_base, ONLY: hpsi
USE cell_module, ONLY: boxdimensions
@ -369,6 +372,7 @@
USE io_global, ONLY: ionode
USE wave_constrains, ONLY: update_lambda
USE reciprocal_space_mesh, ONLY: gkmask_l
USE uspp, ONLY : vkb, nkb
IMPLICIT NONE
@ -592,9 +596,9 @@
timerd = timerd + s3 - s4
IF( tortho ) THEN
CALL ortho( 1, c0(:,:,:,1), cp(:,:,:,1), cdesc, pmss, emass )
CALL ortho( 1, c0(:,:,:,1), cp(:,:,:,1), cdesc, pmss, emass )
ELSE
CALL gram(1, cp(:,:,:,1), cdesc)
CALL gram( vkb, bec, nkb, cp(1,1,1,1), SIZE(cp,1), cdesc%nbt( 1 ) )
END IF

12
CPV/rundiis.f90
View File

@ -80,7 +80,7 @@
USE energies, ONLY: dft_energy_type
USE electrons_module, ONLY: pmss
USE time_step, ONLY: delt
USE wave_functions, ONLY: gram, proj, crot
USE wave_functions, ONLY: proj, crot
USE phase_factors_module, ONLY: strucf, phfacs
USE charge_mix
USE charge_density, ONLY: rhoofr
@ -100,6 +100,7 @@
USE reciprocal_vectors, ONLY: mill_l
USE gvecp, ONLY: ngm
USE local_pseudo, ONLY: vps
USE uspp, ONLY : vkb, nkb
IMPLICIT NONE
@ -200,7 +201,7 @@
CALL newrho(rhoe(:,:,:,1), drho, 0) ! memorize density
CALL phfacs( ei1, ei2, ei3, eigr, mill_l, atoms%taus, nr1, nr2, nr3, atoms%nat )
CALL strucf( sfac, ei1, ei2, ei3, mill_l, ngm )
CALL guessc0( .NOT. kp%gamma_only, c0, cm, cdesc)
CALL guessc0( .NOT. kp%gamma_only, bec, c0, cm, cdesc)
! ... Initialize the rotation index srot
srot = srot0
@ -334,7 +335,7 @@
svar3_0,edft%etot,fs(:,1,1),eigr,sfac,vps, &
treset_diis,istate,cnorm,eold,ndiis,nowv)
CALL gram(c0, cdesc)
CALL gram( vkb, bec, nkb, c0(1,1,1,1), SIZE(c0,1), cdesc%nbt( 1 ) )
END DO DIIS_LOOP
@ -438,7 +439,7 @@
USE energies, ONLY: dft_energy_type
USE electrons_module, ONLY: ei, pmss
USE time_step, ONLY: delt
USE wave_functions, ONLY: gram, proj, update_wave_functions
USE wave_functions, ONLY: proj, update_wave_functions
USE diis
USE cell_module, ONLY: boxdimensions
USE check_stop, ONLY: check_stop_now
@ -452,6 +453,7 @@
USE atoms_type_module, ONLY: atoms_type
USE charge_types, ONLY: charge_descriptor
USE local_pseudo, ONLY: vps
USE uspp, ONLY : vkb, nkb
IMPLICIT NONE
@ -600,7 +602,7 @@
vps, ttreset_diis(ispin), istate, cnorm, &
eold, ndiis, nowv)
END IF
CALL gram( ispin, c0(:,:,:,ispin), cdesc)
CALL gram( vkb, bec, nkb, c0(1,1,1,ispin), SIZE(c0,1), cdesc%nbt( ispin ) )
IF (.NOT.kp%gamma_only) THEN
DEALLOCATE(clambda)
ELSE

6
CPV/smcp.f90
View File

@ -524,7 +524,7 @@ SUBROUTINE smdmain( tau, fion_out, etot_out, nat_out )
!
CALL prefor(eigr,vkb)
!
CALL gram(vkb,rep_el(sm_k)%bec,rep_el(sm_k)%cm)
CALL gram( vkb, rep_el(sm_k)%bec, nkb, rep_el(sm_k)%cm, ngw, nbsp )
!
IF(iprsta.GE.3) CALL dotcsc(eigr,rep_el(sm_k)%cm)
!
@ -615,7 +615,7 @@ SUBROUTINE smdmain( tau, fion_out, etot_out, nat_out )
CALL ortho (eigr,rep_el(sm_k)%c0,rep_el(sm_k)%phi,rep_el(sm_k)%lambda, &
& bigr,iter,ccc(sm_k),ortho_eps,ortho_max,delt,bephi,becp)
ELSE
CALL gram(vkb,rep_el(sm_k)%bec,rep_el(sm_k)%c0)
CALL gram( vkb, rep_el(sm_k)%bec, nkb, rep_el(sm_k)%c0, ngw, nbsp )
!
IF(ionode) WRITE( sm_file,*) ' gram c0 '
ENDIF
@ -1165,7 +1165,7 @@ SUBROUTINE smdmain( tau, fion_out, etot_out, nat_out )
& (eigr,rep_el(sm_k)%cm,rep_el(sm_k)%phi,rep_el(sm_k)%lambda, &
& bigr,iter,ccc(sm_k),ortho_eps,ortho_max,delt,bephi,becp)
ELSE
CALL gram(vkb,rep_el(sm_k)%bec,rep_el(sm_k)%cm)
CALL gram( vkb, rep_el(sm_k)%bec, nkb, rep_el(sm_k)%cm, ngw, nbsp )
IF(iprsta.GT.4) CALL dotcsc(eigr,rep_el(sm_k)%cm)
ENDIF
!

199
CPV/wave.f90
View File

@ -19,8 +19,6 @@
! routines in this module:
! REAL(DP) FUNCTION dft_kinetic_energy(c,hg,f,nb)
! REAL(DP) FUNCTION cp_kinetic_energy(cp,cm,pmss,emass,delt)
! SUBROUTINE rande(cm,ampre)
! SUBROUTINE gram(cp)
! SUBROUTINE update_wave_functions(cm,c0,cp)
! SUBROUTINE crot_gamma (c0,lambda,eig)
! SUBROUTINE crot_kp (ik,c0,lambda,eig)
@ -38,19 +36,13 @@
PRIVATE
PUBLIC :: crot, proj, gram, rande, fixwave
PUBLIC :: crot, proj, fixwave
INTERFACE crot
MODULE PROCEDURE crot_kp, crot_gamma
END INTERFACE
INTERFACE proj
MODULE PROCEDURE proj_kp, proj_gamma, proj2
END INTERFACE
INTERFACE rande
MODULE PROCEDURE rande_s, rande_v, rande_m
END INTERFACE
INTERFACE gram
MODULE PROCEDURE gram_s, gram_v, gram_m
END INTERFACE
INTERFACE fixwave
MODULE PROCEDURE fixwave_s, fixwave_v, fixwave_m
END INTERFACE
@ -250,96 +242,6 @@
END FUNCTION dft_kinetic_energy_s
!=----------------------------------------------------------------------------=!
SUBROUTINE rande_v( ispin, cm, cdesc, ampre )
! randomize wave functions coefficients
! then orthonormalize them
USE wave_types, ONLY: wave_descriptor
USE wave_base, ONLY: rande_base
IMPLICIT NONE
! ... declare subroutine arguments
COMPLEX(DP), INTENT(INOUT) :: cm(:,:,:)
TYPE (wave_descriptor), INTENT(IN) :: cdesc
INTEGER, INTENT(IN) :: ispin
REAL(DP) ampre
! ... declare other variables
INTEGER ik
DO ik = 1, cdesc%nkl
call rande_base( cm(:,:,ik), ampre )
END DO
CALL gram( ispin, cm, cdesc )
RETURN
END SUBROUTINE rande_v
!=----------------------------------------------------------------------------=!
SUBROUTINE rande_m( cm, cdesc, ampre )
! randomize wave functions coefficients
! then orthonormalize them
!
USE wave_base, ONLY: rande_base
USE wave_types, ONLY: wave_descriptor
USE control_flags, ONLY: force_pairing
IMPLICIT NONE
! ... declare subroutine arguments
COMPLEX(DP), INTENT(INOUT) :: cm(:,:,:,:)
TYPE (wave_descriptor), INTENT(IN) :: cdesc
REAL(DP) ampre
! ... declare other variables
INTEGER :: ik, ispin, nspin
nspin = cdesc%nspin
IF( force_pairing ) nspin = 1
DO ispin = 1, nspin
DO ik = 1, cdesc%nkl
call rande_base( cm( :, :, ik, ispin), ampre )
END DO
END DO
CALL gram( cm, cdesc )
RETURN
END SUBROUTINE rande_m
!=----------------------------------------------------------------------------=!
SUBROUTINE rande_s( ispin, cm, cdesc, ampre )
! randomize wave functions coefficients
! then orthonormalize them
!
USE wave_types, ONLY: wave_descriptor
USE wave_base, ONLY: rande_base
IMPLICIT NONE
! ... declare subroutine arguments
COMPLEX(DP), INTENT(INOUT) :: cm(:,:)
TYPE (wave_descriptor), INTENT(IN) :: cdesc
INTEGER, INTENT(IN) :: ispin
REAL(DP) ampre
CALL rande_base( cm(:,:), ampre )
CALL gram( ispin, cm, cdesc )
RETURN
END SUBROUTINE rande_s
!=----------------------------------------------------------------------------=!
SUBROUTINE fixwave_s ( ispin, c, cdesc, kmask )
@ -473,105 +375,6 @@
RETURN
END FUNCTION cp_kinetic_energy
!=----------------------------------------------------------------------------=!
SUBROUTINE gram_m( cp, cdesc )
! ... declare modules
USE mp_global, ONLY: group
USE wave_types, ONLY: wave_descriptor
USE wave_base, ONLY: gram_gamma_base, gram_kp_base
USE control_flags, ONLY: force_pairing
IMPLICIT NONE
! ... declare other variables
COMPLEX(DP), INTENT(INOUT) :: cp(:,:,:,:)
TYPE (wave_descriptor), INTENT(IN) :: cdesc
INTEGER :: ik, ispin, n, nspin
! ... end of declarations
nspin = cdesc%nspin
IF( force_pairing ) nspin = 1
DO ispin = 1, nspin
DO ik = 1, cdesc%nkl
n = cdesc%nbl( ispin )
IF( cdesc%gamma ) THEN
CALL gram_gamma_base( cp( :, 1:n, ik, ispin), cdesc%gzero, group )
ELSE
CALL gram_kp_base( cp( :, 1:n, ik,ispin), group )
END IF
END DO
END DO
RETURN
END SUBROUTINE gram_m
!=----------------------------------------------------------------------------=!
SUBROUTINE gram_v( ispin, cp, cdesc )
! ... declare modules
USE mp_global, ONLY: group
USE wave_types, ONLY: wave_descriptor
USE wave_base, ONLY: gram_gamma_base, gram_kp_base
IMPLICIT NONE
! ... declare other variables
COMPLEX(DP), INTENT(INOUT) :: cp(:,:,:)
TYPE (wave_descriptor), INTENT(IN) :: cdesc
INTEGER, INTENT(IN) :: ispin
INTEGER :: ik
INTEGER :: n
! ... end of declarations
n = cdesc%nbl( ispin )
DO ik = 1, cdesc%nkl
IF( cdesc%gamma ) THEN
CALL gram_gamma_base( cp( :, 1:n, ik), cdesc%gzero, group )
ELSE
CALL gram_kp_base( cp( :, 1:n, ik), group )
END IF
END DO
RETURN
END SUBROUTINE gram_v
!=----------------------------------------------------------------------------=!
SUBROUTINE gram_s( ispin, cp, cdesc )
! ... declare modules
USE mp_global, ONLY: group
USE wave_types, ONLY: wave_descriptor
USE wave_base, ONLY: gram_gamma_base, gram_kp_base
IMPLICIT NONE
! ... declare other variables
COMPLEX(DP), INTENT(INOUT) :: cp(:,:)
INTEGER, INTENT(IN) :: ispin
TYPE (wave_descriptor), INTENT(IN) :: cdesc
INTEGER :: n
! ... end of declarations
n = cdesc%nbl( ispin )
IF( cdesc%gamma ) THEN
CALL gram_gamma_base( cp( :, 1:n ), cdesc%gzero, group )
ELSE
CALL gram_kp_base( cp( :, 1:n ), group )
END IF
RETURN
END SUBROUTINE gram_s
!=----------------------------------------------------------------------------=!
SUBROUTINE update_wave_functions(cm, c0, cp, cdesc)

42
flib/simpsn.f90
View File

@ -66,45 +66,3 @@ subroutine simpson_cp90( mesh, func, rab, intg )
return
end subroutine simpson_cp90
!
!===============================================================
!
! Copyright (C) 2002 FPMD 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,
! or http://www.gnu.org/copyleft/gpl.txt .
!
!
SUBROUTINE simpson_fpmd(n, func, dx, s)
USE kinds
IMPLICIT NONE
INTEGER, INTENT(IN) :: N
REAL(DP), INTENT(IN) :: func(N), dx
REAL(DP), INTENT(OUT) :: S
REAL(DP) :: C1,C2,C3,C4
PARAMETER(C1=109.d0/48.d0,C2=-5.d0/48.d0, C3=63.d0/48.d0,C4=49.d0/48.d0)
INTEGER I
! ... Subroutine body
S = func(1)*C1
S = S + func(2)*C2
S = S + func(3)*C3
S = S + func(4)*C4
DO I = 5, (N-5)
S = S + func(I)
END DO
S = S + func(N-4)*C4
S = S + func(N-3)*C3
S = S + func(N-2)*C2
S = S + func(N-1)*C1
S = S * dx
RETURN
END SUBROUTINE simpson_fpmd