mirror of https://gitlab.com/QEF/q-e.git
- clean-up, there was still two version of rhoofr,
now only one remains git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@4554 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
parent
86986d99c6
commit
3b61944c12
|
@ -64,10 +64,11 @@
|
|||
|
||||
|
||||
|
||||
!=----------------------------------------------------------------------=!
|
||||
SUBROUTINE rhoofr_fpmd ( nfi, tstress, c0, fi, rhor, omega, ekin, dekin )
|
||||
!=----------------------------------------------------------------------=!
|
||||
|
||||
!-----------------------------------------------------------------------
|
||||
SUBROUTINE rhoofr_cp &
|
||||
( nfi, c, irb, eigrb, bec, rhovan, rhor, rhog, rhos, enl, denl, ekin, dekin )
|
||||
!-----------------------------------------------------------------------
|
||||
!
|
||||
! this routine computes:
|
||||
! rhor = normalized electron density in real space
|
||||
! ekin = kinetic energy
|
||||
|
@ -86,226 +87,6 @@
|
|||
! ib = index of band
|
||||
! ig = index of G vector
|
||||
! ----------------------------------------------
|
||||
|
||||
! ... declare modules
|
||||
|
||||
USE kinds, ONLY: DP
|
||||
USE fft_base, ONLY: dfftp, dffts
|
||||
USE mp_global, ONLY: intra_image_comm
|
||||
USE mp, ONLY: mp_sum
|
||||
USE turbo, ONLY: tturbo, nturbo, turbo_states, allocate_turbo
|
||||
USE io_global, ONLY: stdout, ionode
|
||||
USE control_flags, ONLY: iprint, use_task_groups
|
||||
USE grid_dimensions, ONLY: nr1, nr2, nr3, nr1x, nr2x, nnrx
|
||||
USE cp_interfaces, ONLY: invfft
|
||||
USE electrons_base, ONLY: iupdwn, nupdwn, nspin
|
||||
USE cp_interfaces, ONLY: dft_total_charge, stress_kin
|
||||
USE gvecw, ONLY: ngw
|
||||
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
! ... declare subroutine arguments
|
||||
|
||||
INTEGER, INTENT(IN) :: nfi
|
||||
LOGICAL, INTENT(IN) :: tstress
|
||||
COMPLEX(DP) :: c0(:,:)
|
||||
REAL(DP), INTENT(IN) :: fi(:)
|
||||
REAL(DP), INTENT(OUT) :: rhor(:,:)
|
||||
REAL(DP), INTENT(IN) :: omega
|
||||
REAL(DP), INTENT(OUT) :: ekin
|
||||
REAL(DP), INTENT(OUT) :: dekin( 6 )
|
||||
|
||||
! ... declare other variables
|
||||
|
||||
INTEGER :: i, is1, is2, j, ib, nb, iss
|
||||
INTEGER :: nnr, iwfc1, iwfc2
|
||||
REAL(DP) :: r2, r1, coef3, coef4, rsumg( nspin ), rsumgs
|
||||
REAL(DP) :: fact, rsumr( nspin )
|
||||
COMPLEX(DP), ALLOCATABLE :: psi2(:)
|
||||
INTEGER :: ierr
|
||||
LOGICAL :: ttprint
|
||||
|
||||
REAL(DP), EXTERNAL :: enkin
|
||||
|
||||
! ... end of declarations
|
||||
! ----------------------------------------------
|
||||
|
||||
CALL start_clock( 'rhoofr' )
|
||||
|
||||
IF( use_task_groups ) &
|
||||
CALL errore( ' rhoofr_fpmd ', ' tasks group not implemented in fpmd ', 1 )
|
||||
|
||||
! ... compute kinetic energy
|
||||
|
||||
ekin = 0.0d0
|
||||
|
||||
DO iss = 1, nspin
|
||||
ekin = ekin + enkin( c0( 1, iupdwn(iss) ), SIZE( c0, 1 ), fi( iupdwn( iss ) ), nupdwn(iss) )
|
||||
END DO
|
||||
|
||||
IF( tstress ) THEN
|
||||
!
|
||||
! ... compute kinetic energy contribution
|
||||
!
|
||||
CALL stress_kin( dekin, c0, fi )
|
||||
!
|
||||
END IF
|
||||
|
||||
nnr = dfftp%nr1x * dfftp%nr2x * dfftp%npl
|
||||
|
||||
rsumg = 0.0d0
|
||||
rsumr = 0.0d0
|
||||
|
||||
ttprint = ( nfi == 0 ) .OR. ( MOD( nfi, iprint ) == 0 )
|
||||
|
||||
ALLOCATE( psi2( nnrx ), STAT=ierr )
|
||||
IF( ierr /= 0 ) CALL errore(' rhoofr ', ' allocating psi2 ', ABS(ierr) )
|
||||
|
||||
IF( tturbo ) THEN
|
||||
!
|
||||
! ... if tturbo=.TRUE. some data is stored in memory instead of being
|
||||
! ... recalculated (see card 'TURBO')
|
||||
!
|
||||
CALL allocate_turbo( nnrx )
|
||||
|
||||
END IF
|
||||
|
||||
rhor = 0.0d0
|
||||
|
||||
DO iss = 1, nspin
|
||||
|
||||
! ... arrange for FFT of wave functions
|
||||
! ... Gamma-point calculation: wave functions are real and can be
|
||||
! ... Fourier-transformed two at a time as a complex vector
|
||||
|
||||
psi2 = 0.0d0
|
||||
|
||||
nb = ( nupdwn(iss) - MOD( nupdwn(iss), 2 ) )
|
||||
|
||||
DO ib = 1, nb / 2
|
||||
|
||||
is1 = 2*ib - 1 ! band index of the first wave function
|
||||
is2 = is1 + 1 ! band index of the second wave function
|
||||
|
||||
iwfc1 = is1 + iupdwn( iss ) - 1
|
||||
iwfc2 = is2 + iupdwn( iss ) - 1
|
||||
|
||||
! ... Fourier-transform wave functions to real-scaled space
|
||||
! ... psi(s,ib,iss) = INV_FFT ( c0(ig,ib,iss) )
|
||||
|
||||
CALL c2psi( psi2, dffts%nnr, c0( 1, iwfc1 ), c0( 1, iwfc2 ), ngw, 2 )
|
||||
CALL invfft( 'Wave',psi2, dffts%nr1, dffts%nr2, dffts%nr3, dffts%nr1x, dffts%nr2x, dffts%nr3x )
|
||||
|
||||
IF( tturbo .AND. ( ib <= nturbo ) ) THEN
|
||||
! ... store real-space wave functions to be used in force
|
||||
turbo_states( :, ib ) = psi2( : )
|
||||
END IF
|
||||
|
||||
! ... occupation numbers divided by cell volume
|
||||
! ... Remember: rhor( r ) = rhor( s ) / omega
|
||||
|
||||
coef3 = fi( iwfc1 ) / omega
|
||||
coef4 = fi( iwfc2 ) / omega
|
||||
|
||||
! ... compute charge density from wave functions
|
||||
|
||||
DO i = 1, nnr
|
||||
|
||||
! ... extract wave functions from psi2
|
||||
|
||||
r1 = DBLE( psi2(i) )
|
||||
r2 = AIMAG( psi2(i) )
|
||||
|
||||
! ... add squared moduli to charge density
|
||||
|
||||
rhor(i,iss) = rhor(i,iss) + coef3 * r1 * r1 + coef4 * r2 * r2
|
||||
|
||||
END DO
|
||||
|
||||
END DO
|
||||
|
||||
IF( MOD( nupdwn(iss), 2 ) /= 0 ) THEN
|
||||
|
||||
nb = nupdwn(iss)
|
||||
|
||||
iwfc1 = nb + iupdwn( iss ) - 1
|
||||
|
||||
! ... Fourier-transform wave functions to real-scaled space
|
||||
|
||||
CALL c2psi( psi2, dffts%nnr, c0( 1, iwfc1 ), c0( 1, iwfc1 ), ngw, 1 )
|
||||
CALL invfft( 'Wave', psi2, dffts%nr1, dffts%nr2, dffts%nr3, dffts%nr1x, dffts%nr2x, dffts%nr3x )
|
||||
|
||||
! ... occupation numbers divided by cell volume
|
||||
|
||||
coef3 = fi( iwfc1 ) / omega
|
||||
|
||||
! ... compute charge density from wave functions
|
||||
|
||||
DO i = 1, nnr
|
||||
|
||||
! ... extract wave functions from psi2
|
||||
|
||||
r1 = DBLE( psi2(i) )
|
||||
|
||||
! ... add squared moduli to charge density
|
||||
|
||||
rhor(i,iss) = rhor(i,iss) + coef3 * r1 * r1
|
||||
|
||||
END DO
|
||||
|
||||
END IF
|
||||
|
||||
IF( ttprint ) rsumr( iss ) = SUM( rhor( :, iss ) ) * omega / ( nr1 * nr2 * nr3 )
|
||||
|
||||
END DO
|
||||
|
||||
|
||||
IF( ttprint ) THEN
|
||||
!
|
||||
DO iss = 1, nspin
|
||||
fact = 2.d0
|
||||
iwfc1 = iupdwn( iss )
|
||||
rsumgs = dft_total_charge( c0( :, iwfc1 : iwfc1+nupdwn(iss)-1 ), ngw, &
|
||||
fi( iwfc1 : iwfc1+nupdwn(iss)-1 ), nupdwn(iss) )
|
||||
rsumg( iss ) = rsumg( iss ) + fact * rsumgs
|
||||
END DO
|
||||
!
|
||||
CALL mp_sum( rsumg( 1:nspin ), intra_image_comm )
|
||||
CALL mp_sum( rsumr( 1:nspin ), intra_image_comm )
|
||||
!
|
||||
if ( nspin == 1 ) then
|
||||
WRITE( stdout, 10) rsumg(1), rsumr(1)
|
||||
else
|
||||
WRITE( stdout, 20) rsumg(1), rsumr(1), rsumg(2), rsumr(2)
|
||||
endif
|
||||
|
||||
10 FORMAT( /, 3X, 'from rhoofr: total integrated electronic density', &
|
||||
& /, 3X, 'in g-space = ', f11.6, 3x, 'in r-space =', f11.6 )
|
||||
20 FORMAT( /, 3X, 'from rhoofr: total integrated electronic density', &
|
||||
& /, 3X, 'spin up', &
|
||||
& /, 3X, 'in g-space = ', f11.6, 3x, 'in r-space =', f11.6 , &
|
||||
& /, 3X, 'spin down', &
|
||||
& /, 3X, 'in g-space = ', f11.6, 3x, 'in r-space =', f11.6 )
|
||||
|
||||
|
||||
END IF
|
||||
|
||||
DEALLOCATE(psi2, STAT=ierr)
|
||||
IF( ierr /= 0 ) CALL errore(' rhoofr ', ' deallocating psi2 ', ABS(ierr) )
|
||||
|
||||
CALL stop_clock( 'rhoofr' )
|
||||
|
||||
RETURN
|
||||
!=----------------------------------------------------------------------=!
|
||||
END SUBROUTINE rhoofr_fpmd
|
||||
!=----------------------------------------------------------------------=!
|
||||
|
||||
|
||||
!-----------------------------------------------------------------------
|
||||
SUBROUTINE rhoofr_cp &
|
||||
( nfi, c, irb, eigrb, bec, rhovan, rhor, rhog, rhos, enl, denl, ekin, dekin )
|
||||
!-----------------------------------------------------------------------
|
||||
! the normalized electron density rhor in real space
|
||||
! the kinetic energy ekin
|
||||
! subroutine uses complex fft so it computes two ft's
|
||||
|
@ -318,7 +99,7 @@
|
|||
! e_v = sum_i,ij rho_i,ij d^ion_is,ji
|
||||
!
|
||||
USE kinds, ONLY: DP
|
||||
USE control_flags, ONLY: iprint, iprsta, thdyn, tpre, trhor, use_task_groups
|
||||
USE control_flags, ONLY: iprint, iprsta, thdyn, tpre, trhor, use_task_groups, program_name
|
||||
USE ions_base, ONLY: nat
|
||||
USE gvecp, ONLY: ngm
|
||||
USE gvecs, ONLY: ngs, nps, nms
|
||||
|
@ -385,16 +166,22 @@
|
|||
ekin = enkin( c, ngw, f, n )
|
||||
!
|
||||
IF( tpre ) THEN
|
||||
!
|
||||
! ... compute kinetic energy contribution
|
||||
!
|
||||
CALL stress_kin( dekin, c, f )
|
||||
!
|
||||
END IF
|
||||
!
|
||||
! calculation of non-local energy
|
||||
!
|
||||
enl = ennl( rhovan, bec )
|
||||
!
|
||||
IF( tpre ) CALL dennl( bec, denl )
|
||||
IF( program_name == 'CP90' ) THEN
|
||||
!
|
||||
! calculation of non-local energy
|
||||
!
|
||||
enl = ennl( rhovan, bec )
|
||||
!
|
||||
IF( tpre ) CALL dennl( bec, denl )
|
||||
!
|
||||
END IF
|
||||
!
|
||||
! warning! trhor and thdyn are not compatible yet!
|
||||
!
|
||||
|
@ -557,7 +344,9 @@
|
|||
! add vanderbilt contribution to the charge density
|
||||
! drhov called before rhov because input rho must be the smooth part
|
||||
!
|
||||
IF ( tpre ) CALL drhov( irb, eigrb, rhovan, rhog, rhor )
|
||||
!
|
||||
IF ( tpre .AND. program_name == 'CP90' ) &
|
||||
CALL drhov( irb, eigrb, rhovan, rhog, rhor )
|
||||
!
|
||||
CALL rhov( irb, eigrb, rhovan, rhog, rhor )
|
||||
|
||||
|
|
|
@ -107,7 +107,6 @@
|
|||
|
||||
|
||||
PUBLIC :: vofmean
|
||||
PUBLIC :: kspotential
|
||||
PUBLIC :: vofrhos
|
||||
PUBLIC :: vofps
|
||||
PUBLIC :: vofloc
|
||||
|
@ -314,18 +313,6 @@
|
|||
|
||||
|
||||
INTERFACE rhoofr
|
||||
SUBROUTINE rhoofr_fpmd (nfi, tstress, c0, fi, rhor, omega, ekin, dekin)
|
||||
USE kinds, ONLY: DP
|
||||
IMPLICIT NONE
|
||||
INTEGER, INTENT(IN) :: nfi
|
||||
LOGICAL, INTENT(IN) :: tstress
|
||||
COMPLEX(DP) :: c0(:,:)
|
||||
REAL(DP), INTENT(IN) :: fi(:)
|
||||
REAL(DP), INTENT(OUT) :: rhor(:,:)
|
||||
REAL(DP), INTENT(IN) :: omega
|
||||
REAL(DP), INTENT(OUT) :: ekin
|
||||
REAL(DP), INTENT(OUT) :: dekin(6)
|
||||
END SUBROUTINE rhoofr_fpmd
|
||||
SUBROUTINE rhoofr_cp &
|
||||
( nfi, c, irb, eigrb, bec, rhovan, rhor, rhog, rhos, enl, denl, ekin, dekin )
|
||||
USE kinds, ONLY: DP
|
||||
|
@ -1092,40 +1079,10 @@
|
|||
END SUBROUTINE
|
||||
END INTERFACE
|
||||
|
||||
INTERFACE kspotential
|
||||
SUBROUTINE kspotential_x &
|
||||
( nfi, tprint, tforce, tstress, rhoe, atoms, bec, becdr, eigr, &
|
||||
ei1, ei2, ei3, sfac, c0, tcel, ht, fi, vpot, edft )
|
||||
USE kinds, ONLY: DP
|
||||
USE energies, ONLY: dft_energy_type
|
||||
USE cell_base, ONLY: boxdimensions
|
||||
USE atoms_type_module, ONLY: atoms_type
|
||||
USE wave_types, ONLY: wave_descriptor
|
||||
IMPLICIT NONE
|
||||
INTEGER, INTENT(IN) :: nfi
|
||||
LOGICAL, INTENT(IN) :: tforce, tstress, tprint
|
||||
REAL(DP) :: rhoe(:,:)
|
||||
TYPE (atoms_type), INTENT(INOUT) :: atoms
|
||||
REAL(DP) :: bec(:,:)
|
||||
REAL(DP) :: becdr(:,:,:)
|
||||
COMPLEX(DP) :: eigr(:,:)
|
||||
COMPLEX(DP) :: ei1(:,:)
|
||||
COMPLEX(DP) :: ei2(:,:)
|
||||
COMPLEX(DP) :: ei3(:,:)
|
||||
COMPLEX(DP), INTENT(IN) :: sfac(:,:)
|
||||
COMPLEX(DP), INTENT(INOUT) :: c0(:,:)
|
||||
LOGICAL :: tcel
|
||||
TYPE (boxdimensions), INTENT(INOUT) :: ht
|
||||
REAL(DP), INTENT(IN) :: fi(:)
|
||||
REAL(DP) :: vpot(:,:)
|
||||
TYPE (dft_energy_type) :: edft
|
||||
END SUBROUTINE
|
||||
END INTERFACE
|
||||
|
||||
|
||||
INTERFACE vofrhos
|
||||
SUBROUTINE vofrhos_x &
|
||||
( tprint, tforce, tstress, rhoe, atoms, vpot, bec, c0, fi, &
|
||||
( tprint, tforce, tstress, rhoe, rhoeg, atoms, vpot, bec, c0, fi, &
|
||||
eigr, ei1, ei2, ei3, sfac, box, edft )
|
||||
USE kinds, ONLY: DP
|
||||
USE energies, ONLY: dft_energy_type
|
||||
|
@ -1135,6 +1092,7 @@
|
|||
IMPLICIT NONE
|
||||
LOGICAL, INTENT(IN) :: tprint, tforce, tstress
|
||||
REAL(DP) :: rhoe(:,:)
|
||||
COMPLEX(DP) :: rhoeg(:,:)
|
||||
TYPE (atoms_type), INTENT(INOUT) :: atoms
|
||||
REAL(DP) :: vpot(:,:)
|
||||
REAL(DP) :: bec(:,:)
|
||||
|
|
|
@ -1897,21 +1897,23 @@ END FUNCTION
|
|||
!
|
||||
IMPLICIT NONE
|
||||
!
|
||||
REAL(8) :: rhovan(nhm*(nhm+1)/2,nat,nspin)
|
||||
REAL(DP) :: rhovan(nhm*(nhm+1)/2,nat,nspin)
|
||||
INTEGER, INTENT(in) :: irb(3,nat)
|
||||
COMPLEX(8), INTENT(in):: eigrb(ngb,nat)
|
||||
REAL(8), INTENT(inout):: rhor(nnr,nspin)
|
||||
COMPLEX(8), INTENT(inout):: rhog(ng,nspin)
|
||||
COMPLEX(DP), INTENT(in):: eigrb(ngb,nat)
|
||||
REAL(DP), INTENT(inout):: rhor(nnr,nspin)
|
||||
COMPLEX(DP), INTENT(inout):: rhog(ng,nspin)
|
||||
!
|
||||
INTEGER isup, isdw, nfft, ifft, iv, jv, ig, ijv, is, iss, &
|
||||
& isa, ia, ir, i, j
|
||||
REAL(8) sumrho
|
||||
COMPLEX(8) ci, fp, fm, ca
|
||||
COMPLEX(8), ALLOCATABLE:: qgbt(:,:)
|
||||
COMPLEX(8), ALLOCATABLE:: v(:)
|
||||
COMPLEX(8), ALLOCATABLE:: qv(:)
|
||||
!
|
||||
IF (nvb.EQ.0) RETURN
|
||||
INTEGER :: isup, isdw, nfft, ifft, iv, jv, ig, ijv, is, iss, isa, ia, ir, i, j
|
||||
REAL(DP) :: sumrho
|
||||
COMPLEX(DP) :: ci, fp, fm, ca
|
||||
COMPLEX(DP), ALLOCATABLE :: qgbt(:,:)
|
||||
COMPLEX(DP), ALLOCATABLE :: v(:)
|
||||
COMPLEX(DP), ALLOCATABLE :: qv(:)
|
||||
|
||||
! Quick return if this sub is not needed
|
||||
!
|
||||
IF ( nvb == 0 ) RETURN
|
||||
|
||||
CALL start_clock( 'rhov' )
|
||||
ci=(0.d0,1.d0)
|
||||
!
|
||||
|
|
|
@ -342,9 +342,9 @@ CONTAINS
|
|||
|
||||
CALL nlrh( cm, ttforce, tstress, atoms%for, bec, becdr, eigr, edft%enl, denl6 )
|
||||
!
|
||||
CALL rhoofr( 0, tstress, cm, f, rhor, ht%deth, edft%ekin, dekin6 )
|
||||
CALL rhoofr( 0, cm(:,:), irb, eigrb, bec, becsum, rhor, rhog, rhos, edft%enl, denl, edft%ekin, dekin6 )
|
||||
!
|
||||
CALL vofrhos( ttprint, ttforce, tstress, rhor, atoms, &
|
||||
CALL vofrhos( ttprint, ttforce, tstress, rhor, rhog, atoms, &
|
||||
vpot, bec, cm, f, eigr, ei1, ei2, ei3, sfac, ht, edft )
|
||||
!
|
||||
IF( iprsta > 1 ) CALL debug_energies( edft )
|
||||
|
|
13
CPV/main.f90
13
CPV/main.f90
|
@ -107,7 +107,7 @@
|
|||
vnhh, xnhh0, xnhhm, xnhhp, qnh, temph
|
||||
USE cell_base, ONLY: cell_gamma
|
||||
USE grid_subroutines, ONLY: realspace_grids_init, realspace_grids_para
|
||||
USE uspp, ONLY: vkb, nkb, okvan
|
||||
USE uspp, ONLY: vkb, nkb, okvan, becsum
|
||||
!
|
||||
USE reciprocal_vectors, ONLY: &
|
||||
g, & ! G-vectors square modulus
|
||||
|
@ -141,9 +141,9 @@
|
|||
USE io_files, ONLY: outdir, prefix
|
||||
USE printout_base, ONLY: printout_base_init
|
||||
USE cp_main_variables, ONLY: ei1, ei2, ei3, eigr, sfac, lambda, &
|
||||
ht0, htm, htp, rhor, vpot, wfill, &
|
||||
ht0, htm, htp, rhor, vpot, rhog, rhos, wfill, &
|
||||
acc, acc_this_run, edft, nfi, bec, becdr, &
|
||||
ema0bg, descla
|
||||
ema0bg, descla, irb, eigrb
|
||||
USE ions_positions, ONLY: atoms0, atomsp, atomsm
|
||||
USE cg_module, ONLY: tcg
|
||||
USE cp_electronic_mass, ONLY: emass
|
||||
|
@ -163,7 +163,8 @@
|
|||
INTEGER :: n1s, n2s, n3s
|
||||
|
||||
REAL(DP) :: ekinc, ekcell, ekinp, erhoold, maxfion
|
||||
REAL(DP) :: derho
|
||||
REAL(DP) :: derho, dum
|
||||
REAL(DP) :: dum3x3(3,3) = 0.0d0
|
||||
REAL(DP) :: ekmt(3,3) = 0.0d0
|
||||
REAL(DP) :: hgamma(3,3) = 0.0d0
|
||||
REAL(DP) :: gcm1(3,3) = 0.0d0
|
||||
|
@ -284,12 +285,12 @@
|
|||
|
||||
! ... compute the new charge density "rhor"
|
||||
!
|
||||
CALL rhoofr( nfi, tstress, c0, f, rhor, ht0%deth, edft%ekin, dekin6 )
|
||||
CALL rhoofr( nfi, c0, irb, eigrb, bec, becsum, rhor, rhog, rhos, edft%enl, dum3x3, edft%ekin, dekin6 )
|
||||
|
||||
! ... vofrhos compute the new DFT potential "vpot", and energies "edft",
|
||||
! ... ionc forces "fion" and stress "paiu".
|
||||
!
|
||||
CALL vofrhos(ttprint, ttforce, tstress, rhor, atoms0, &
|
||||
CALL vofrhos(ttprint, ttforce, tstress, rhor, rhog, atoms0, &
|
||||
vpot, bec, c0, f, eigr, ei1, ei2, ei3, sfac, ht0, edft)
|
||||
|
||||
! CALL debug_energies( edft ) ! DEBUG
|
||||
|
|
|
@ -168,6 +168,8 @@ MODULE cp_main_variables
|
|||
!
|
||||
ALLOCATE( rhor( nnr, nspin ) )
|
||||
ALLOCATE( vpot( nnr, nspin ) )
|
||||
ALLOCATE( rhos( nnrsx, nspin ) )
|
||||
ALLOCATE( rhog( ng, nspin ) )
|
||||
!
|
||||
! Compute local dimensions for lambda matrixes
|
||||
!
|
||||
|
@ -190,9 +192,6 @@ MODULE cp_main_variables
|
|||
!
|
||||
!
|
||||
IF( program_name == 'CP90' ) THEN
|
||||
!
|
||||
ALLOCATE( rhos( nnrsx, nspin ) )
|
||||
ALLOCATE( rhog( ng, nspin ) )
|
||||
!
|
||||
if ( abivol.or.abisur ) then
|
||||
!
|
||||
|
|
|
@ -115,15 +115,9 @@
|
|||
!
|
||||
IF( nproc_image > 1 ) THEN
|
||||
inl=(iv-1)*na(is)+1
|
||||
! CALL MXMA( wrk2, 2*ngw, 1, c, 1, 2*ngw, becps( inl, 1 ), 1, nhx, na(is), 2*ngw, n )
|
||||
CALL DGEMM( 'T', 'N', na(is), n, 2*ngw, 1.0d0, wrk2, 2*ngw, c, 2*ngw, 0.0d0, becps( inl, 1 ), nhx )
|
||||
|
||||
! subroutine mxma (a,na,iad,b,nb,ibd,c,nc,icd,nar,nac,nbc)
|
||||
! call DGEMM(mode1,mode2,nar,nbc,nac,1.d0,a,lda,b,ldb,0.d0,c,icd)
|
||||
|
||||
ELSE
|
||||
inl=ish(is)+(iv-1)*na(is)+1
|
||||
! call MXMA( wrk2, 2*ngw, 1, c, 1, 2*ngw, becp( inl, 1 ), 1, nkb, na(is), 2*ngw, n )
|
||||
CALL DGEMM( 'T', 'N', na(is), n, 2*ngw, 1.0d0, wrk2, 2*ngw, c, 2*ngw, 0.0d0, becp( inl, 1 ), nkb )
|
||||
END IF
|
||||
|
||||
|
@ -252,7 +246,6 @@
|
|||
end do
|
||||
end do
|
||||
inl=ish(is)+(iv-1)*na(is)+1
|
||||
! call MXMA(wrk2,2*ngw,1,c,1,2*ngw,becdr(inl,1,k),1, nkb,na(is),2*ngw,n)
|
||||
CALL DGEMM( 'T', 'N', na(is), n, 2*ngw, 1.0d0, wrk2, 2*ngw, c, 2*ngw, 0.0d0, becdr( inl, 1, k ), nkb )
|
||||
end do
|
||||
|
||||
|
@ -556,7 +549,6 @@ SUBROUTINE caldbec( ngw, nkb, n, nspmn, nspmx, eigr, c, dbec, tred )
|
|||
end do
|
||||
end do
|
||||
inl=ish(is)+(iv-1)*na(is)+1
|
||||
! call MXMA(wrk2,2*ngw,1,c,1,2*ngw,dbec(inl,1,i,j),1,nkb,na(is),2*ngw,n)
|
||||
CALL DGEMM( 'T', 'N', na(is), n, 2*ngw, 1.0d0, wrk2, 2*ngw, c, 2*ngw, 0.0d0, dbec( inl, 1, i, j ), nkb )
|
||||
end do
|
||||
if( ( nproc_image > 1 ) .AND. tred ) then
|
||||
|
|
|
@ -123,56 +123,11 @@
|
|||
RETURN
|
||||
END SUBROUTINE vofmean_x
|
||||
|
||||
! -------------------------------------------------------------------------
|
||||
|
||||
SUBROUTINE kspotential_x &
|
||||
( nfi, tprint, tforce, tstress, rhoe, atoms, bec, becdr, eigr, &
|
||||
ei1, ei2, ei3, sfac, c0, tcel, ht, fi, vpot, edft )
|
||||
|
||||
USE kinds, ONLY: DP
|
||||
USE cp_interfaces, ONLY: rhoofr, nlrh, vofrhos
|
||||
USE energies, ONLY: dft_energy_type
|
||||
USE cell_base, ONLY: boxdimensions
|
||||
USE atoms_type_module, ONLY: atoms_type
|
||||
USE wave_types, ONLY: wave_descriptor
|
||||
USE dener, ONLY: denl6, dekin6
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
! ... declare subroutine arguments
|
||||
INTEGER, INTENT(IN) :: nfi
|
||||
LOGICAL, INTENT(IN) :: tforce, tstress, tprint
|
||||
REAL(DP) :: rhoe(:,:)
|
||||
TYPE (atoms_type), INTENT(INOUT) :: atoms
|
||||
REAL(DP) :: bec(:,:)
|
||||
REAL(DP) :: becdr(:,:,:)
|
||||
COMPLEX(DP) :: eigr(:,:)
|
||||
COMPLEX(DP) :: ei1(:,:)
|
||||
COMPLEX(DP) :: ei2(:,:)
|
||||
COMPLEX(DP) :: ei3(:,:)
|
||||
COMPLEX(DP), INTENT(IN) :: sfac(:,:)
|
||||
COMPLEX(DP), INTENT(INOUT) :: c0(:,:)
|
||||
LOGICAL :: tcel
|
||||
TYPE (boxdimensions), INTENT(INOUT) :: ht
|
||||
REAL(DP), INTENT(IN) :: fi(:)
|
||||
REAL(DP) :: vpot(:,:)
|
||||
TYPE (dft_energy_type) :: edft
|
||||
|
||||
CALL nlrh( c0, tforce, tstress, atoms%for, bec, becdr, eigr, edft%enl, denl6 )
|
||||
|
||||
CALL rhoofr( nfi, tstress, c0, fi, rhoe, ht%deth, edft%ekin, dekin6 )
|
||||
|
||||
CALL vofrhos( tprint, tforce, tstress, rhoe, atoms, vpot, bec, &
|
||||
c0, fi, eigr, ei1, ei2, ei3, sfac, &
|
||||
ht, edft )
|
||||
|
||||
RETURN
|
||||
END SUBROUTINE kspotential_x
|
||||
|
||||
!=----------------------------------------------------------------------------=!
|
||||
|
||||
SUBROUTINE vofrhos_x &
|
||||
( tprint, tforce, tstress, rhoe, atoms, vpot, bec, c0, fi, &
|
||||
( tprint, tforce, tstress, rhoe, rhoeg, atoms, vpot, bec, c0, fi, &
|
||||
eigr, ei1, ei2, ei3, sfac, box, edft )
|
||||
|
||||
! this routine computes:
|
||||
|
@ -254,7 +209,8 @@
|
|||
TYPE (atoms_type), INTENT(INOUT) :: atoms
|
||||
TYPE (boxdimensions), INTENT(INOUT) :: box
|
||||
TYPE (dft_energy_type) :: edft
|
||||
REAL(DP) :: rhoe(:,:)
|
||||
REAL(DP) :: rhoe(:,:) ! the electronic charge density in real space
|
||||
COMPLEX(DP) :: rhoeg(:,:) ! the electronic charge density in reciprocal space
|
||||
COMPLEX(DP), INTENT(IN) :: sfac(:,:)
|
||||
|
||||
TYPE (dft_energy_type) :: edft_self
|
||||
|
@ -265,7 +221,7 @@
|
|||
! ... declare other variables
|
||||
|
||||
COMPLEX(DP), ALLOCATABLE :: vloc(:), self_vloc(:)
|
||||
COMPLEX(DP), ALLOCATABLE :: rhog(:), drhog(:,:), rhoeg(:,:)
|
||||
COMPLEX(DP), ALLOCATABLE :: rhog(:), drhog(:,:)
|
||||
COMPLEX(DP), ALLOCATABLE :: psi(:)
|
||||
COMPLEX(DP), ALLOCATABLE :: screen_coul(:)
|
||||
!
|
||||
|
@ -334,7 +290,6 @@
|
|||
fion = atoms%for( 1:3, 1:atoms%nat )
|
||||
!
|
||||
|
||||
ALLOCATE( rhoeg ( ngm, nspin ) )
|
||||
ALLOCATE( rhog( ngm ) )
|
||||
ALLOCATE( vloc( ngm ) )
|
||||
ALLOCATE( psi( SIZE( rhoe, 1 ) ) )
|
||||
|
@ -372,18 +327,6 @@
|
|||
END IF
|
||||
END IF
|
||||
|
||||
|
||||
! ... FFT: rho(r) --> rho(g)
|
||||
!
|
||||
DO iss = 1, nspin
|
||||
|
||||
psi = rhoe(:,iss)
|
||||
|
||||
CALL fwfft( 'Dense', psi, dfftp%nr1, dfftp%nr2, dfftp%nr3, dfftp%nr1x, dfftp%nr2x, dfftp%nr3x )
|
||||
CALL psi2rho( 'Dense', psi, dfftp%nnr, rhoeg(:,iss), ngm )
|
||||
|
||||
END DO
|
||||
|
||||
rhog( 1:ngm ) = rhoeg( 1:ngm, 1 )
|
||||
IF( nspin > 1 ) rhog( 1:ngm ) = rhog( 1:ngm ) + rhoeg( 1:ngm, 2 )
|
||||
|
||||
|
@ -675,7 +618,7 @@
|
|||
!
|
||||
atoms%for( 1:3, 1:atoms%nat ) = fion
|
||||
|
||||
DEALLOCATE( rhoeg, rhoetr, grho, v2xc, fion )
|
||||
DEALLOCATE( rhoetr, grho, v2xc, fion )
|
||||
DEALLOCATE( vloc, psi )
|
||||
|
||||
!
|
||||
|
|
|
@ -343,9 +343,9 @@ MODULE from_restart_module
|
|||
!
|
||||
CALL nlrh( c0, ttforce, tstress, atoms0%for, bec, becdr, eigr, edft%enl, denl6 )
|
||||
!
|
||||
CALL rhoofr( nfi, tstress, c0, f, rhor, ht0%deth, edft%ekin, dekin6 )
|
||||
CALL rhoofr( nfi, c0, irb, eigrb, bec, becsum, rhor, rhog, rhos, edft%enl, denl, edft%ekin, dekin6 )
|
||||
!
|
||||
CALL vofrhos( .true. , ttforce, tstress, rhor, &
|
||||
CALL vofrhos( .true. , ttforce, tstress, rhor, rhog, &
|
||||
atoms0, vpot, bec, c0, f, eigr, &
|
||||
ei1, ei2, ei3, sfac, ht0, edft )
|
||||
!
|
||||
|
|
Loading…
Reference in New Issue