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

- more merging: now there is only one dforce routine. 

- developing: some input parameters damped to file qe_input.xml


git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@3819 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
cavazzon 2007-02-26 14:48:03 +00:00
parent 3cce1b4cbc
commit e255615328
11 changed files with 70 additions and 506 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
CPV/Makefile
View File

@ -171,6 +171,7 @@ MODULES = \
../Modules/version.o \ ../Modules/version.o \
../Modules/wavefunctions.o \ ../Modules/wavefunctions.o \
../Modules/wave_base.o \ ../Modules/wave_base.o \
../Modules/xml_input.o \
../Modules/xml_io_base.o ../Modules/xml_io_base.o
WRAPPERS = wrapper.o WRAPPERS = wrapper.o

58
CPV/cp_interfaces.f90
View File

@ -5,6 +5,7 @@
! in the root directory of the present distribution, ! in the root directory of the present distribution,
! or http://www.gnu.org/copyleft/gpl.txt . ! or http://www.gnu.org/copyleft/gpl.txt .
! !
! written by Carlo Cavazzoni
!=----------------------------------------------------------------------------=! !=----------------------------------------------------------------------------=!
MODULE cp_interfaces MODULE cp_interfaces
@ -15,9 +16,6 @@
PUBLIC :: bessel2 PUBLIC :: bessel2
PUBLIC :: bessel3 PUBLIC :: bessel3
PUBLIC :: dforce1
PUBLIC :: dforce2
PUBLIC :: dforce_fpmd
PUBLIC :: dforce PUBLIC :: dforce
PUBLIC :: nlin PUBLIC :: nlin
@ -148,57 +146,6 @@
END INTERFACE END INTERFACE
INTERFACE dforce1
SUBROUTINE dforce1_x( co, ce, dco, dce, fio, fie, hg, v, psi_stored )
USE kinds, ONLY: DP
IMPLICIT NONE
COMPLEX(DP), INTENT(OUT) :: dco(:), dce(:)
COMPLEX(DP), INTENT(IN) :: co(:), ce(:)
REAL(DP), INTENT(IN) :: fio, fie
REAL(DP), INTENT(IN) :: v(:)
REAL(DP), INTENT(IN) :: hg(:)
COMPLEX(DP), OPTIONAL :: psi_stored(:)
END SUBROUTINE dforce1_x
END INTERFACE
INTERFACE dforce2
SUBROUTINE dforce2_x( fio, fie, df, da, vkb, beco, bece )
USE kinds, ONLY: DP
IMPLICIT NONE
COMPLEX(DP), INTENT(IN) :: vkb(:,:)
REAL(DP), INTENT(IN) :: fio, fie
COMPLEX(DP) :: df(:), da(:)
REAL(DP), INTENT(IN) :: beco(:)
REAL(DP), INTENT(IN) :: bece(:)
END SUBROUTINE dforce2_x
END INTERFACE
INTERFACE dforce_fpmd
SUBROUTINE dforce_fpmd_x( ib, c, f, df, da, v, vkb, bec, n, noffset )
USE kinds, ONLY: DP
IMPLICIT NONE
INTEGER, INTENT(IN) :: ib ! band index
COMPLEX(DP), INTENT(IN) :: c(:,:)
COMPLEX(DP), INTENT(OUT) :: df(:), da(:)
REAL (DP), INTENT(IN) :: v(:), bec(:,:), f(:)
COMPLEX(DP), INTENT(IN) :: vkb(:,:)
INTEGER, INTENT(IN) :: n, noffset ! number of bands, and band index offset
END SUBROUTINE dforce_fpmd_x
SUBROUTINE dforce_all( c, f, cgrad, vpot, vkb, bec, n, noffset )
USE kinds, ONLY: DP
IMPLICIT NONE
COMPLEX(DP), INTENT(INOUT) :: c(:,:)
REAL(DP), INTENT(IN) :: vpot(:), f(:)
COMPLEX(DP), INTENT(OUT) :: cgrad(:,:)
COMPLEX(DP), INTENT(IN) :: vkb(:,:)
REAL(DP), INTENT(IN) :: bec(:,:)
INTEGER, INTENT(IN) :: n, noffset
END SUBROUTINE dforce_all
END INTERFACE
INTERFACE dforce INTERFACE dforce
SUBROUTINE dforce_x( i, bec, vkb, c, df, da, v, ldv, ispin, f, n, nspin, v1 ) SUBROUTINE dforce_x( i, bec, vkb, c, df, da, v, ldv, ispin, f, n, nspin, v1 )
USE kinds, ONLY: DP USE kinds, ONLY: DP
@ -488,7 +435,7 @@
END SUBROUTINE writefile_cp END SUBROUTINE writefile_cp
SUBROUTINE writefile_fpmd & SUBROUTINE writefile_fpmd &
( nfi, trutime, c0, cm, occ, atoms_0, atoms_m, acc, taui, cdmi, ht_m, & ( nfi, trutime, c0, cm, occ, atoms_0, atoms_m, acc, taui, cdmi, ht_m, &
ht_0, rho, vpot, lambda ) ht_0, rho, vpot, lambda, tlast )
USE kinds, ONLY: DP USE kinds, ONLY: DP
USE cell_base, ONLY: boxdimensions USE cell_base, ONLY: boxdimensions
USE atoms_type_module, ONLY: atoms_type USE atoms_type_module, ONLY: atoms_type
@ -504,6 +451,7 @@
REAL(DP), INTENT(IN) :: acc(:), cdmi(:) REAL(DP), INTENT(IN) :: acc(:), cdmi(:)
REAL(DP), INTENT(IN) :: trutime REAL(DP), INTENT(IN) :: trutime
REAL(DP), INTENT(IN) :: lambda(:,:,:) REAL(DP), INTENT(IN) :: lambda(:,:,:)
LOGICAL, INTENT(IN) :: tlast
END SUBROUTINE writefile_fpmd END SUBROUTINE writefile_fpmd
END INTERFACE END INTERFACE

238
CPV/forces.f90
View File

@ -13,229 +13,6 @@
#include "f_defs.h" #include "f_defs.h"
SUBROUTINE dforce1_x( co, ce, dco, dce, fio, fie, hg, v, psi_stored )
USE kinds, ONLY: DP
USE fft_base, ONLY: dffts
USE gvecw, ONLY: ngw
USE cp_interfaces, ONLY: fwfft, invfft
USE cell_base, ONLY: tpiba2
IMPLICIT NONE
! ... declare subroutine arguments
COMPLEX(DP), INTENT(OUT) :: dco(:), dce(:)
COMPLEX(DP), INTENT(IN) :: co(:), ce(:)
REAL(DP), INTENT(IN) :: fio, fie
REAL(DP), INTENT(IN) :: v(:)
REAL(DP), INTENT(IN) :: hg(:)
COMPLEX(DP), OPTIONAL :: psi_stored(:)
! ... declare other variables
!
COMPLEX(DP), ALLOCATABLE :: psi(:)
COMPLEX(DP) :: fp, fm, aro, are
REAL(DP) :: fioby2, fieby2, arg
INTEGER :: ig
! end of declarations
ALLOCATE( psi( SIZE(v) ) )
IF( PRESENT( psi_stored ) ) THEN
psi = psi_stored * CMPLX(v, 0.0d0)
ELSE
CALL c2psi( psi, dffts%nnr, co, ce, ngw, 2 )
CALL invfft( 'Wave', psi, dffts%nr1, dffts%nr2, dffts%nr3, dffts%nr1x, dffts%nr2x, dffts%nr3x )
psi = psi * CMPLX(v, 0.0d0)
END IF
CALL fwfft( 'Wave', psi, dffts%nr1, dffts%nr2, dffts%nr3, dffts%nr1x, dffts%nr2x, dffts%nr3x )
CALL psi2c( psi, dffts%nnr, dco, dce, ngw, 2 )
DEALLOCATE(psi)
fioby2 = fio * 0.5d0
fieby2 = fie * 0.5d0
DO ig = 1, SIZE(co)
fp = dco(ig) + dce(ig)
fm = dco(ig) - dce(ig)
aro = CMPLX( DBLE(fp), AIMAG(fm) )
are = CMPLX( AIMAG(fp), -DBLE(fm))
arg = tpiba2 * hg(ig)
dco(ig) = -fioby2 * (arg * co(ig) + aro)
dce(ig) = -fieby2 * (arg * ce(ig) + are)
END DO
RETURN
END SUBROUTINE dforce1_x
!=----------------------------------------------------------------------------=!
SUBROUTINE dforce2_x( fio, fie, df, da, vkb, beco, bece )
! this routine computes:
! the generalized force df=CMPLX(dfr,dfi) acting on the i-th
! electron state at the ik-th point of the Brillouin zone
! represented by the vector c=CMPLX(cr,ci)
! ----------------------------------------------
USE kinds, ONLY: DP
USE ions_base, ONLY: na
USE read_pseudo_module_fpmd, ONLY: nspnl
USE uspp_param, ONLY: nh
USE uspp, ONLY: nhtol, nhtolm, indv, beta, dvan, nkb
use cvan, ONLY: ish
!
IMPLICIT NONE
! ... declare subroutine arguments
COMPLEX(DP), INTENT(IN) :: vkb(:,:)
REAL(DP), INTENT(IN) :: fio, fie
COMPLEX(DP) :: df(:), da(:)
REAL(DP), INTENT(IN) :: beco(:)
REAL(DP), INTENT(IN) :: bece(:)
! ... declare other variables
REAL(DP) :: to, te
INTEGER :: l, is, ig, ngw, iv, inl, isa
! ----------------------------------------------
ngw = SIZE(df)
isa = 1
DO is = 1, nspnl
!
DO iv = 1, nh( is )
!
inl = ish(is) + (iv-1) * na(is) + 1
to = - fio * dvan( iv, iv, is )
!
te = - fie * dvan( iv, iv, is )
CALL DGEMV('N', 2*ngw, na(is), to, vkb( 1, inl ), &
2*SIZE(vkb,1), beco( inl ), 1, 1.0d0, df, 1)
!
CALL DGEMV('N', 2*ngw, na(is), te, vkb( 1, inl ), &
2*SIZE(vkb,1), bece( inl ), 1, 1.0d0, da, 1)
!
END DO
!
isa = isa + na( is )
!
END DO
!
RETURN
END SUBROUTINE dforce2_x
!=----------------------------------------------------------------------------=!
SUBROUTINE dforce_fpmd_x( ib, c, f, df, da, v, vkb, bec, n, noffset )
!
USE kinds, ONLY: DP
USE reciprocal_vectors, ONLY: ggp, g, gx
USE cp_interfaces
!
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: ib ! band index
COMPLEX(DP), INTENT(IN) :: c(:,:)
COMPLEX(DP), INTENT(OUT) :: df(:), da(:)
REAL (DP), INTENT(IN) :: v(:), bec(:,:), f(:)
COMPLEX(DP), INTENT(IN) :: vkb(:,:)
INTEGER, INTENT(IN) :: n, noffset ! number of bands, and band index offset
!
COMPLEX(DP), ALLOCATABLE :: dum( : )
!
INTEGER :: in
!
IF( ib > n ) CALL errore( ' dforce ', ' ib out of range ', 1 )
!
in = noffset + ib - 1
!
IF( ib == n ) THEN
!
ALLOCATE( dum( SIZE( df ) ) )
!
CALL dforce1( c( :, in ), c( :, in ), df, dum, f( in ), f( in ), ggp, v )
!
CALL dforce2( f( in ), f( in ), df , dum , vkb, bec( :, in ), bec( :, in ) )
!
DEALLOCATE( dum )
!
ELSE
!
CALL dforce1( c( :, in ), c( :, in+1 ), df, da, f( in ), f(in+1), ggp, v )
!
CALL dforce2( f(in), f(in+1), df, da, vkb, bec( :, in ), bec( :, in+1 ) )
!
END IF
!
RETURN
END SUBROUTINE dforce_fpmd_x
! ----------------------------------------------
SUBROUTINE dforce_all( c, f, cgrad, vpot, vkb, bec, n, noffset )
!
USE kinds, ONLY: DP
USE cp_interfaces
IMPLICIT NONE
COMPLEX(DP), INTENT(INOUT) :: c(:,:)
REAL(DP), INTENT(IN) :: vpot(:), f(:)
COMPLEX(DP), INTENT(OUT) :: cgrad(:,:)
COMPLEX(DP), INTENT(IN) :: vkb(:,:)
REAL(DP), INTENT(IN) :: bec(:,:)
INTEGER, INTENT(IN) :: n, noffset
INTEGER :: ib, in
!
IF( n > 0 ) THEN
!
! Process two states at the same time
!
DO ib = 1, n-1, 2
!
in = ib + noffset - 1
!
CALL dforce_fpmd( ib, c, f, cgrad(:,in), cgrad(:,in+1), vpot, vkb, bec, n, noffset )
!
END DO
!
! and now process the last state in case that n is odd
!
IF( MOD( n, 2 ) /= 0 ) THEN
!
in = n + noffset - 1
!
CALL dforce_fpmd( n, c, f, cgrad(:,in), cgrad(:,in), vpot, vkb, bec, n, noffset )
!
END IF
!
END IF
!
RETURN
END SUBROUTINE dforce_all
! !
!------------------------------------------------------------------------- !-------------------------------------------------------------------------
SUBROUTINE dforce_x ( i, bec, vkb, c, df, da, v, ldv, ispin, f, n, nspin, v1 ) SUBROUTINE dforce_x ( i, bec, vkb, c, df, da, v, ldv, ispin, f, n, nspin, v1 )
@ -250,7 +27,7 @@
! !
USE parallel_include USE parallel_include
USE kinds, ONLY: dp USE kinds, ONLY: dp
USE control_flags, ONLY: iprint, use_task_groups USE control_flags, ONLY: iprint, use_task_groups, program_name
USE gvecs, ONLY: nms, nps USE gvecs, ONLY: nms, nps
USE cvan, ONLY: ish USE cvan, ONLY: ish
USE uspp, ONLY: nhsa=>nkb, dvan, deeq USE uspp, ONLY: nhsa=>nkb, dvan, deeq
@ -484,6 +261,18 @@
! !
DO is = 1, nsp DO is = 1, nsp
DO iv = 1, nh(is) DO iv = 1, nh(is)
IF( program_name == 'FPMD' ) THEN
ivoff = ish(is) + (iv-1) * na(is)
dd = dvan( iv, iv, is )
DO inl = ivoff + 1, ivoff + na(is)
af(inl,igrp) = af(inl,igrp) - fi * dd * bec(inl,i+idx-1)
END DO
IF( i + idx - 1 /= n ) THEN
DO inl = ivoff + 1, ivoff + na(is)
aa(inl,igrp) = aa(inl,igrp) - fip * dd * bec(inl,i+idx)
END DO
END IF
ELSE
DO jv = 1, nh(is) DO jv = 1, nh(is)
isa = 0 isa = 0
DO ism = 1, is-1 DO ism = 1, is-1
@ -511,6 +300,7 @@
END DO END DO
END IF END IF
END DO END DO
END IF
END DO END DO
END DO END DO

17
CPV/input.f90
View File

@ -37,6 +37,7 @@ MODULE input
program_name program_name
USE printout_base, ONLY : title_ => title USE printout_base, ONLY : title_ => title
USE io_global, ONLY : meta_ionode, stdout USE io_global, ONLY : meta_ionode, stdout
USE xml_input, ONLY : xml_input_dump
! !
IMPLICIT NONE IMPLICIT NONE
! !
@ -45,7 +46,10 @@ MODULE input
! !
prog = 'CP' prog = 'CP'
! !
IF ( meta_ionode ) CALL input_from_file() IF ( meta_ionode ) THEN
CALL xml_input_dump()
CALL input_from_file()
END IF
! !
! ... Read NAMELISTS ! ... Read NAMELISTS
! !
@ -832,7 +836,7 @@ MODULE input
!------------------------------------------------------------------------- !-------------------------------------------------------------------------
! !
USE control_flags, ONLY : program_name, lconstrain, lneb, lmetadyn, & USE control_flags, ONLY : program_name, lconstrain, lneb, lmetadyn, &
tpre, thdyn tpre, thdyn, tksw
USE constants, ONLY : amu_au, pi USE constants, ONLY : amu_au, pi
! !
@ -914,7 +918,7 @@ MODULE input
REAL(DP) :: alat_ , massa_totale REAL(DP) :: alat_ , massa_totale
REAL(DP) :: ethr_emp_inp REAL(DP) :: ethr_emp_inp
! ... DIIS ! ... DIIS
INTEGER :: ia INTEGER :: ia, iss
LOGICAL :: ltest LOGICAL :: ltest
! !
! Subroutine Body ! Subroutine Body
@ -1002,6 +1006,13 @@ MODULE input
! !
CALL ks_states_init( nspin, nprnks, iprnks, nprnks_empty, iprnks_empty ) CALL ks_states_init( nspin, nprnks, iprnks, nprnks_empty, iprnks_empty )
!
! kohn-sham states implies disk-io = 'high'
!
DO iss = 1, nspin
tksw = tksw .OR. ( nprnks(iss) > 0 )
tksw = tksw .OR. ( nprnks_empty(iss) > 0 )
END DO
CALL electrons_base_initval( zv, na_inp, ntyp, nelec, nelup, & CALL electrons_base_initval( zv, na_inp, ntyp, nelec, nelup, &
neldw, nbnd, nspin, occupations, f_inp, & neldw, nbnd, nspin, occupations, f_inp, &

7
CPV/ions.f90
View File

@ -71,13 +71,6 @@
CONTAINS CONTAINS
! BEGIN manual -------------------------------------------------------------
! ------------------- TEMPLATE OF SUBROUTINE COMMENTS ----------------------
! SUBROUTINE pippo(arg1, arg2, ...)
! Descrive briefly what pippo does and the meaning of arguments
! --------------------------------------------------------------------------
! END manual ---------------------------------------------------------------
! BEGIN manual ------------------------------------------------------------- ! BEGIN manual -------------------------------------------------------------

145
CPV/ksstates.f90
View File

@ -28,7 +28,7 @@ MODULE kohn_sham_states
INTEGER, ALLOCATABLE :: n_ksout_emp(:) ! (spin indxs) INTEGER, ALLOCATABLE :: n_ksout_emp(:) ! (spin indxs)
PUBLIC :: ks_states_init, ks_states_closeup PUBLIC :: ks_states_init, ks_states_closeup
PUBLIC :: n_ksout, indx_ksout, ks_states, tksout PUBLIC :: n_ksout, indx_ksout, tksout, print_all_states
! ---------------------------------------------- ! ----------------------------------------------
CONTAINS CONTAINS
@ -95,138 +95,9 @@ CONTAINS
END SUBROUTINE ks_states_closeup END SUBROUTINE ks_states_closeup
! ---------------------------------------------- ! ----------------------------------------------
SUBROUTINE ks_states(cf, occ, vpot, eigr, vkb, bec )
! ... declare modules
USE kinds
USE mp_global, ONLY : intra_image_comm
USE io_global, ONLY : ionode, stdout
USE ions_base, ONLY : nsp
USE cp_interfaces, ONLY : dforce_fpmd, kohn_sham
USE control_flags, ONLY : force_pairing
USE electrons_base, ONLY : nupdwn, iupdwn, nspin, nbsp
USE electrons_module, ONLY : n_emp, nupdwn_emp, iupdwn_emp, nb_l, n_emp_l
USE gvecw, ONLY : ngw
USE cp_interfaces, ONLY : readempty
USE uspp, ONLY : nkb
IMPLICIT NONE
! ... declare subroutine arguments
COMPLEX(DP), INTENT(INOUT) :: cf(:,:)
COMPLEX(DP) :: eigr(:,:)
COMPLEX(DP) :: vkb(:,:)
REAL(DP), INTENT(IN) :: occ(:), bec(:,:)
REAL(DP) :: vpot(:,:)
! ... declare other variables
INTEGER :: i, ib, ig, nb_g, iss, iks
INTEGER :: n_emps
LOGICAL :: tortho = .TRUE.
LOGICAL :: exist
COMPLEX(DP), ALLOCATABLE :: fforce(:,:)
COMPLEX(DP), ALLOCATABLE :: eforce(:,:)
COMPLEX(DP), ALLOCATABLE :: ce(:,:)
REAL(DP), ALLOCATABLE :: bec_emp(:,:)
REAL(DP), ALLOCATABLE :: fi(:)
CHARACTER (LEN=6), EXTERNAL :: int_to_char
! ... end of declarations
IF( tksout ) THEN
ALLOCATE( fforce( ngw, SIZE( cf, 2 ) ) )
DO iss = 1, nspin
IF( nupdwn( iss ) > 0 ) THEN
CALL dforce_fpmd( cf, occ, fforce, vpot(:,iss), vkb, bec, nupdwn(iss), iupdwn(iss) )
END IF
END DO
IF( force_pairing ) THEN
DO i = 1, nupdwn(2)
fforce(:,i) = occ(i) * fforce(:,i) + occ(i+iupdwn(2)-1) * fforce(:,i+iupdwn(2)-1)
END DO
DO i = nupdwn(2)+1, nupdwn(1)
fforce(:,i) = occ(i) * fforce(:,i)
END DO
DO i = iupdwn(2), iupdwn(2) + nupdwn(2) - 1
fforce(:,i) = fforce(:,i-iupdwn(2)+1)
END DO
END IF
DO iss = 1, nspin
CALL kohn_sham( cf, ngw, fforce, nupdwn( iss ), nb_l(iss), iupdwn( iss ) )
END DO
DEALLOCATE( fforce )
END IF
IF( tksout_emp ) THEN
n_emps = nupdwn_emp( 1 )
IF( nspin == 2 ) n_emps = n_emps + nupdwn_emp( 2 )
ALLOCATE( ce( ngw, n_emp * nspin ) )
!
ALLOCATE( bec_emp( nkb, n_emps ) )
exist = readempty( ce, n_emp * nspin )
IF( .NOT. exist ) &
CALL errore( ' ks_states ', ' empty states file not found', 1 )
CALL nlsm1 ( n_emps, 1, nsp, eigr, ce, bec_emp )
ALLOCATE( eforce( ngw, SIZE( ce, 2 ) ) )
ALLOCATE( fi( SIZE( ce, 2 ) ) )
fi = 2.0d0 / nspin
DO iss = 1, nspin
IF( nupdwn_emp( iss ) > 0 ) THEN
CALL dforce_fpmd( ce, fi, eforce, vpot(:,iss), vkb, bec_emp, nupdwn_emp( iss ), iupdwn_emp( iss ) )
CALL kohn_sham( ce, ngw, eforce, nupdwn_emp( iss ), n_emp_l(iss), iupdwn_emp( iss ) )
END IF
END DO
DEALLOCATE( fi )
DEALLOCATE( eforce )
DEALLOCATE( bec_emp )
END IF
CALL print_all_states( cf, ce )
IF( tksout_emp ) THEN
DEALLOCATE( ce )
END IF
RETURN
!
END SUBROUTINE ks_states
! ---------------------------------------------- ! ----------------------------------------------
SUBROUTINE print_all_states( cf, ce ) SUBROUTINE print_all_states( ctot, iupdwn_tot, nupdwn_tot )
USE kinds, ONLY : DP USE kinds, ONLY : DP
USE mp_global, ONLY : intra_image_comm USE mp_global, ONLY : intra_image_comm
@ -238,10 +109,12 @@ CONTAINS
IMPLICIT NONE IMPLICIT NONE
! ... declare subroutine arguments ! ... declare subroutine arguments
COMPLEX(DP), INTENT(INOUT) :: cf(:,:), ce(:,:) COMPLEX(DP), INTENT(IN) :: ctot(:,:)
INTEGER, INTENT(IN) :: iupdwn_tot(2)
INTEGER, INTENT(IN) :: nupdwn_tot(2)
! ... declare other variables ! ... declare other variables
INTEGER :: i, iss, iks INTEGER :: i, iss, iks, itot
CHARACTER(LEN=256) :: file_name CHARACTER(LEN=256) :: file_name
CHARACTER(LEN=10), DIMENSION(2) :: spin_name CHARACTER(LEN=10), DIMENSION(2) :: spin_name
@ -268,9 +141,10 @@ CONTAINS
DO i = 1, n_ksout(iss) DO i = 1, n_ksout(iss)
iks = indx_ksout(i, iss) iks = indx_ksout(i, iss)
IF( ( iks > 0 ) .AND. ( iks <= nupdwn( iss ) ) ) THEN IF( ( iks > 0 ) .AND. ( iks <= nupdwn( iss ) ) ) THEN
itot = iks + iupdwn_tot(iss) - 1
file_name = TRIM( ks_file ) // & file_name = TRIM( ks_file ) // &
& trim(spin_name(iss)) // trim( int_to_char( iks ) ) & trim(spin_name(iss)) // trim( int_to_char( iks ) )
CALL print_ks_states( cf(:,iks+iupdwn(iss)-1), file_name ) CALL print_ks_states( ctot( :, itot ), file_name )
END IF END IF
END DO END DO
END IF END IF
@ -278,9 +152,10 @@ CONTAINS
DO i = 1, n_ksout_emp(iss) DO i = 1, n_ksout_emp(iss)
iks = indx_ksout_emp(i, iss) iks = indx_ksout_emp(i, iss)
IF( ( iks > 0 ) .AND. ( iks <= nupdwn_emp( iss ) ) ) THEN IF( ( iks > 0 ) .AND. ( iks <= nupdwn_emp( iss ) ) ) THEN
itot = iks + iupdwn_tot(iss) + nupdwn( iss ) - 1
file_name = TRIM( ks_emp_file ) // & file_name = TRIM( ks_emp_file ) // &
& trim(spin_name(iss)) // trim( int_to_char( iks ) ) & trim(spin_name(iss)) // trim( int_to_char( iks ) )
CALL print_ks_states( ce(:,iupdwn_emp(iss)+iks-1), file_name ) CALL print_ks_states( ctot( :, itot ), file_name )
END IF END IF
END DO END DO
END IF END IF

5
CPV/main.f90
View File

@ -89,7 +89,6 @@
USE time_step, ONLY: tps, delt USE time_step, ONLY: tps, delt
USE wave_types USE wave_types
use wave_base, only: frice use wave_base, only: frice
USE kohn_sham_states, ONLY: ks_states, tksout, n_ksout, indx_ksout, ks_states_closeup
USE io_global, ONLY: ionode USE io_global, ONLY: ionode
USE io_global, ONLY: stdout USE io_global, ONLY: stdout
USE input, ONLY: iosys USE input, ONLY: iosys
@ -585,7 +584,7 @@
! !
IF( ttsave .OR. ttexit ) THEN IF( ttsave .OR. ttexit ) THEN
CALL writefile( nfi, tps, c0, cm, f, atoms0, atomsm, acc, & CALL writefile( nfi, tps, c0, cm, f, atoms0, atomsm, acc, &
taui, cdmi, htm, ht0, rhor, vpot, lambda ) taui, cdmi, htm, ht0, rhor, vpot, lambda, ttexit )
END IF END IF
! ... loop back ! ... loop back
@ -606,8 +605,6 @@
END DO END DO
END IF END IF
! !
CALL ks_states(c0, f, vpot, eigr, vkb, bec )
IF(tprnsfac) THEN IF(tprnsfac) THEN
CALL print_sfac(rhor, sfac) CALL print_sfac(rhor, sfac)
END IF END IF

7
CPV/make.depend
View File

@ -446,7 +446,6 @@ forces.o : ../Modules/uspp.o
forces.o : cp_interfaces.o forces.o : cp_interfaces.o
forces.o : ensemble_dft.o forces.o : ensemble_dft.o
forces.o : modules.o forces.o : modules.o
forces.o : read_pseudo.o
fpmdpp.o : ../Modules/constants.o fpmdpp.o : ../Modules/constants.o
fpmdpp.o : ../Modules/io_files.o fpmdpp.o : ../Modules/io_files.o
fpmdpp.o : ../Modules/kind.o fpmdpp.o : ../Modules/kind.o
@ -620,6 +619,7 @@ input.o : ../Modules/read_namelists.o
input.o : ../Modules/sic.o input.o : ../Modules/sic.o
input.o : ../Modules/timestep.o input.o : ../Modules/timestep.o
input.o : ../Modules/wave_base.o input.o : ../Modules/wave_base.o
input.o : ../Modules/xml_input.o
input.o : cg.o input.o : cg.o
input.o : chargemix.o input.o : chargemix.o
input.o : cp_emass.o input.o : cp_emass.o
@ -647,18 +647,15 @@ ions.o : ../Modules/timestep.o
ions.o : atoms_type.o ions.o : atoms_type.o
ions_positions.o : ../Modules/kind.o ions_positions.o : ../Modules/kind.o
ions_positions.o : atoms_type.o ions_positions.o : atoms_type.o
ksstates.o : ../Modules/control_flags.o
ksstates.o : ../Modules/electrons_base.o ksstates.o : ../Modules/electrons_base.o
ksstates.o : ../Modules/fft_base.o ksstates.o : ../Modules/fft_base.o
ksstates.o : ../Modules/griddim.o ksstates.o : ../Modules/griddim.o
ksstates.o : ../Modules/io_files.o ksstates.o : ../Modules/io_files.o
ksstates.o : ../Modules/io_global.o ksstates.o : ../Modules/io_global.o
ksstates.o : ../Modules/ions_base.o
ksstates.o : ../Modules/kind.o ksstates.o : ../Modules/kind.o
ksstates.o : ../Modules/mp.o ksstates.o : ../Modules/mp.o
ksstates.o : ../Modules/mp_global.o ksstates.o : ../Modules/mp_global.o
ksstates.o : ../Modules/recvec.o ksstates.o : ../Modules/recvec.o
ksstates.o : ../Modules/uspp.o
ksstates.o : ../Modules/xml_io_base.o ksstates.o : ../Modules/xml_io_base.o
ksstates.o : cp_interfaces.o ksstates.o : cp_interfaces.o
ksstates.o : electrons.o ksstates.o : electrons.o
@ -692,7 +689,6 @@ main.o : electrons.o
main.o : input.o main.o : input.o
main.o : ions.o main.o : ions.o
main.o : ions_positions.o main.o : ions_positions.o
main.o : ksstates.o
main.o : mainvar.o main.o : mainvar.o
main.o : modules.o main.o : modules.o
main.o : polarization.o main.o : polarization.o
@ -1008,6 +1004,7 @@ restart.o : cp_interfaces.o
restart.o : cp_restart.o restart.o : cp_restart.o
restart.o : electrons.o restart.o : electrons.o
restart.o : ensemble_dft.o restart.o : ensemble_dft.o
restart.o : ksstates.o
restart.o : mainvar.o restart.o : mainvar.o
restart_sub.o : ../Modules/cell_base.o restart_sub.o : ../Modules/cell_base.o
restart_sub.o : ../Modules/control_flags.o restart_sub.o : ../Modules/control_flags.o

7
CPV/restart.f90
View File

@ -5,6 +5,7 @@
! in the root directory of the present distribution, ! in the root directory of the present distribution,
! or http://www.gnu.org/copyleft/gpl.txt . ! or http://www.gnu.org/copyleft/gpl.txt .
! !
! written by Carlo Cavazzoni
!----------------------------------------------------------------------- !-----------------------------------------------------------------------
@ -227,7 +228,7 @@
SUBROUTINE writefile_fpmd & SUBROUTINE writefile_fpmd &
( nfi, trutime, c0, cm, occ, atoms_0, atoms_m, acc, taui, cdmi, ht_m, & ( nfi, trutime, c0, cm, occ, atoms_0, atoms_m, acc, taui, cdmi, ht_m, &
ht_0, rho, vpot, lambda ) ht_0, rho, vpot, lambda, tlast )
USE kinds, ONLY: DP USE kinds, ONLY: DP
USE cell_base, ONLY: boxdimensions, r_to_s USE cell_base, ONLY: boxdimensions, r_to_s
@ -245,6 +246,7 @@
USE io_files, ONLY: outdir USE io_files, ONLY: outdir
USE grid_dimensions, ONLY: nr1, nr2, nr3, nr1x, nr2x, nr3x USE grid_dimensions, ONLY: nr1, nr2, nr3, nr1x, nr2x, nr3x
USE cp_interfaces, ONLY: set_evtot, set_eitot USE cp_interfaces, ONLY: set_evtot, set_eitot
USE kohn_sham_states, ONLY: print_all_states
IMPLICIT NONE IMPLICIT NONE
@ -259,6 +261,7 @@
REAL(DP), INTENT(IN) :: acc(:), cdmi(:) REAL(DP), INTENT(IN) :: acc(:), cdmi(:)
REAL(DP), INTENT(IN) :: trutime REAL(DP), INTENT(IN) :: trutime
REAL(DP), INTENT(IN) :: lambda(:,:,:) REAL(DP), INTENT(IN) :: lambda(:,:,:)
LOGICAL, INTENT(IN) :: tlast
REAL(DP) :: ekincm REAL(DP) :: ekincm
INTEGER :: i, j, k, ir INTEGER :: i, j, k, ir
@ -291,6 +294,8 @@
! !
CALL set_evtot( c0, ctot, lambda, iupdwn_tot, nupdwn_tot ) CALL set_evtot( c0, ctot, lambda, iupdwn_tot, nupdwn_tot )
! !
IF( tlast ) CALL print_all_states( ctot, iupdwn_tot, nupdwn_tot )
!
END IF END IF
! !
CALL cp_writefile( ndw, outdir, .TRUE., nfi, trutime, acc, nkpt, xk, wk, & CALL cp_writefile( ndw, outdir, .TRUE., nfi, trutime, acc, nkpt, xk, wk, &

67
CPV/runcp.f90
View File

@ -37,7 +37,7 @@
use efield_module, only : dforce_efield, tefield, dforce_efield2, tefield2 use efield_module, only : dforce_efield, tefield, dforce_efield2, tefield2
USE task_groups, ONLY : nolist USE task_groups, ONLY : nolist
use gvecw, only : ngw use gvecw, only : ngw
USE cp_interfaces, ONLY : dforce_fpmd, dforce USE cp_interfaces, ONLY : dforce
USE ldaU USE ldaU
! !
IMPLICIT NONE IMPLICIT NONE
@ -118,7 +118,6 @@
c3 = 0D0 c3 = 0D0
IF( use_task_groups ) THEN IF( use_task_groups ) THEN
! !
! The potential in rhos is distributed accros all processors ! The potential in rhos is distributed accros all processors
! We need to redistribute it so that it is completely contained in the ! We need to redistribute it so that it is completely contained in the
@ -174,38 +173,23 @@
ELSE ELSE
IF( program_name == 'FPMD' ) THEN CALL dforce( i, bec, vkb, c0, c2, c3, rhos, SIZE(rhos,1), ispin, f, n, nspin )
is = ispin( i )
ii = i - iupdwn(is) + 1
iwfc = iupdwn(is)
nwfc = nupdwn(is)
CALL dforce_fpmd( ii, c0, f, c2, c3, rhos(:,is), vkb, bec, nwfc, iwfc )
IF( ii == nwfc ) c3 = 0.0d0
ELSE
CALL dforce( i, bec, vkb, c0, c2, c3, rhos, SIZE(rhos,1), ispin, f, n, nspin )
END IF
END IF END IF
if (lda_plus_u) then IF ( lda_plus_u ) THEN
c2(:)=c2(:)-vupsi(:,i) c2(:) = c2(:) - vupsi(:,i)
c3(:)=c3(:)-vupsi(:,i+1) c3(:) = c3(:) - vupsi(:,i+1)
endif END IF
if( tefield ) then IF( tefield ) THEN
CALL dforce_efield ( bec, i, c0, c2, c3, rhos) CALL dforce_efield ( bec, i, c0, c2, c3, rhos)
end if END IF
if( tefield2 ) then IF( tefield2 ) THEN
CALL dforce_efield2 ( bec, i, c0, c2, c3, rhos) CALL dforce_efield2 ( bec, i, c0, c2, c3, rhos)
end if END IF
IF( iflag == 2 ) THEN IF( iflag == 2 ) THEN
DO idx = 1, incr, 2 DO idx = 1, incr, 2
@ -270,7 +254,7 @@
USE wannier_subroutines, ONLY : ef_potential USE wannier_subroutines, ONLY : ef_potential
USE efield_module, ONLY : dforce_efield, tefield USE efield_module, ONLY : dforce_efield, tefield
USE electrons_base, ONLY : ispin, nspin, f, n=>nbsp USE electrons_base, ONLY : ispin, nspin, f, n=>nbsp
USE cp_interfaces, ONLY : dforce_fpmd, dforce USE cp_interfaces, ONLY : dforce
! !
USE gvecw, ONLY: ngw USE gvecw, ONLY: ngw
! !
@ -376,23 +360,17 @@
DO i = 1, npair, 2 DO i = 1, npair, 2
! !
IF( program_name == 'FPMD' ) THEN CALL dforce(i,bec,vkb,c0,c2,c3,rhos(:,1:1),SIZE(rhos,1),ispin,f,n,nspin)
CALL dforce_fpmd( i, c0, f, c2, c3, rhos(:,1), vkb, bec, nupdwn(2), iupdwn(1) ) CALL dforce(i,bec,vkb,c0,c4,c5,rhos(:,2:2),SIZE(rhos,1),ispin,f,n,nspin)
CALL dforce_fpmd( i, c0, f, c4, c5, rhos(:,2), vkb, bec, nupdwn(2), iupdwn(1) )
ELSE
CALL dforce(i,bec,vkb,c0,c2,c3,rhos(:,1:1),SIZE(rhos,1),ispin,f,n,nspin)
CALL dforce(i,bec,vkb,c0,c4,c5,rhos(:,2:2),SIZE(rhos,1),ispin,f,n,nspin)
END IF
! !
c2 = occ( i )*(c2 + c4) c2 = occ( i )*(c2 + c4)
c3 = occ(i+1)*(c3 + c5) c3 = occ(i+1)*(c3 + c5)
! !
IF( iflag == 2 ) THEN IF( iflag == 2 ) THEN
cm(:,i) = c0(:,i) cm(:,i) = c0(:,i)
cm(:,i+1) = c0(:,i+1) cm(:,i+1) = c0(:,i+1)
END IF END IF
! !
IF( ttsde ) THEN IF( ttsde ) THEN
CALL wave_steepest( cm(:, i ), c0(:, i ), emaver, c2 ) CALL wave_steepest( cm(:, i ), c0(:, i ), emaver, c2 )
CALL wave_steepest( cm(:, i+1), c0(:, i+1), emaver, c3 ) CALL wave_steepest( cm(:, i+1), c0(:, i+1), emaver, c3 )
@ -400,7 +378,7 @@
CALL wave_verlet( cm(:, i ), c0(:, i ), verl1, verl2, emaver, c2 ) CALL wave_verlet( cm(:, i ), c0(:, i ), verl1, verl2, emaver, c2 )
CALL wave_verlet( cm(:, i+1), c0(:, i+1), verl1, verl2, emaver, c3 ) CALL wave_verlet( cm(:, i+1), c0(:, i+1), verl1, verl2, emaver, c3 )
END IF END IF
! !
IF ( gstart == 2 ) THEN IF ( gstart == 2 ) THEN
cm(1, i) = CMPLX(DBLE(cm(1, i)),0.d0) cm(1, i) = CMPLX(DBLE(cm(1, i)),0.d0)
cm(1, i+1) = CMPLX(DBLE(cm(1, i+1)),0.d0) cm(1, i+1) = CMPLX(DBLE(cm(1, i+1)),0.d0)
@ -412,13 +390,8 @@
npair = n_unp - 1 npair = n_unp - 1
! !
IF( program_name == 'FPMD' ) THEN CALL dforce(npair,bec,vkb,c0,c2,c3,rhos(:,1:1),SIZE(rhos,1),ispin,f,n,nspin)
CALL dforce_fpmd( npair, c0, f, c2, c3, rhos(:,1), vkb, bec, nupdwn(2), iupdwn(1) ) CALL dforce(npair,bec,vkb,c0,c4,c5,rhos(:,2:2),SIZE(rhos,1),ispin,f,n,nspin)
CALL dforce_fpmd( npair, c0, f, c4, c5, rhos(:,2), vkb, bec, nupdwn(2), iupdwn(1) )
ELSE
CALL dforce(npair,bec,vkb,c0,c2,c3,rhos(:,1:1),SIZE(rhos,1),ispin,f,n,nspin)
CALL dforce(npair,bec,vkb,c0,c4,c5,rhos(:,2:2),SIZE(rhos,1),ispin,f,n,nspin)
END IF
! !
c2 = c2 + c4 c2 = c2 + c4
! !
@ -447,11 +420,7 @@
! "TRUE" ONLY WHEN THE POT is NORM_CONSERVING ! "TRUE" ONLY WHEN THE POT is NORM_CONSERVING
! !
IF( program_name == 'FPMD' ) THEN CALL dforce( n_unp, bec, vkb, c0, c2, c3, rhos, SIZE(rhos,1), ispin,f,n,nspin )
CALL dforce_fpmd( n_unp, c0, f, c2, c3, rhos(:,1), vkb, bec, nupdwn(1), iupdwn(1) )
ELSE
CALL dforce( n_unp, bec, vkb, c0, c2, c3, rhos, SIZE(rhos,1), ispin,f,n,nspin )
END IF
! !
intermed = - 2.d0 * sum(c2 * conjg(c0(:,n_unp))) intermed = - 2.d0 * sum(c2 * conjg(c0(:,n_unp)))
IF ( gstart == 2 ) THEN IF ( gstart == 2 ) THEN

24
CPV/wf.f90
View File

@ -890,10 +890,8 @@ SUBROUTINE ddyn( m, Omat, Umat, b1, b2, b3 )
DO inw=1, nw DO inw=1, nw
X1(:, :)=Omat(inw, :, :) X1(:, :)=Omat(inw, :, :)
U3=ZERO U3=ZERO
! call ZGEMUL(U2, m, 'T', X1, m, 'nbsp', U3, m, m,m,m)
CALL ZGEMM ('T', 'N', m,m,m,ONE,U2,m,X1,m,ZERO,U3,m) CALL ZGEMM ('T', 'N', m,m,m,ONE,U2,m,X1,m,ZERO,U3,m)
X1=ZERO X1=ZERO
! call ZGEMUL(U3, m, 'nbsp', U2, m, 'nbsp', X1, m, m,m,m)
CALL ZGEMM ('N','N', m,m,m,ONE,U3,m,U2,m,ZERO,X1,m) CALL ZGEMM ('N','N', m,m,m,ONE,U3,m,U2,m,ZERO,X1,m)
Oc(inw, :, :)=X1(:, :) Oc(inw, :, :)=X1(:, :)
END DO END DO
@ -919,13 +917,9 @@ SUBROUTINE ddyn( m, Omat, Umat, b1, b2, b3 )
END DO END DO
IF(ABS(t0-oldt0).LT.tolw) THEN IF(ABS(t0-oldt0).LT.tolw) THEN
#ifdef __PARA
IF(me.EQ.1) THEN IF(me.EQ.1) THEN
#endif
WRITE(27,*) "MLWF Generated at Step",ini WRITE(27,*) "MLWF Generated at Step",ini
#ifdef __PARA
END IF END IF
#endif
IF(iprsta.GT.4) THEN IF(iprsta.GT.4) THEN
WRITE( stdout, * ) "MLWF Generated at Step",ini WRITE( stdout, * ) "MLWF Generated at Step",ini
END IF END IF
@ -996,10 +990,8 @@ SUBROUTINE ddyn( m, Omat, Umat, b1, b2, b3 )
! U=z*exp(d)*z+ ! U=z*exp(d)*z+
! !
U3=ZERO U3=ZERO
! call ZGEMUL(z, m, 'nbsp', d, m, 'nbsp', U3, m, m,m,m)
CALL ZGEMM ('N', 'N', m,m,m,ONE,z,m,d,m,ZERO,U3,m) CALL ZGEMM ('N', 'N', m,m,m,ONE,z,m,d,m,ZERO,U3,m)
U2=ZERO U2=ZERO
! call ZGEMUL(U3, m, 'nbsp', z, m, 'c', U2, m, m,m,m)
CALL ZGEMM ('N','C', m,m,m,ONE,U3,m,z,m,ZERO,U2,m) CALL ZGEMM ('N','C', m,m,m,ONE,U3,m,z,m,ZERO,U2,m)
U=DBLE(U2) U=DBLE(U2)
U2=ZERO U2=ZERO
@ -1012,7 +1004,6 @@ SUBROUTINE ddyn( m, Omat, Umat, b1, b2, b3 )
! update Umat ! update Umat
! !
! call DGEMUL(Umat, m, 'nbsp', U, m, 'nbsp', U1, m, m,m,m)
U1=ZERO U1=ZERO
CALL DGEMM ('N', 'N', m,m,m,ONE,Umat,m,U,m,ZERO,U1,m) CALL DGEMM ('N', 'N', m,m,m,ONE,Umat,m,U,m,ZERO,U1,m)
@ -1024,10 +1015,8 @@ SUBROUTINE ddyn( m, Omat, Umat, b1, b2, b3 )
U3=ZERO U3=ZERO
DO inw=1, nw DO inw=1, nw
X1(:, :)=Omat(inw, :, :) X1(:, :)=Omat(inw, :, :)
! call ZGEMUL(U2, m, 'T', X1, m, 'nbsp', U3, m, m,m,m)
CALL ZGEMM ('T', 'N', m,m,m,ONE,U2,m,X1,m,ZERO,U3,m) CALL ZGEMM ('T', 'N', m,m,m,ONE,U2,m,X1,m,ZERO,U3,m)
X1=ZERO X1=ZERO
! call ZGEMUL(U3, m, 'nbsp', U2, m, 'nbsp', X1, m, m,m,m)
CALL ZGEMM ('N','N',m,m,m,ONE,U3,m,U2,m,ZERO,X1,m) CALL ZGEMM ('N','N',m,m,m,ONE,U3,m,U2,m,ZERO,X1,m)
Oc(inw, :, :)=X1(:, :) Oc(inw, :, :)=X1(:, :)
END DO END DO
@ -1035,13 +1024,9 @@ SUBROUTINE ddyn( m, Omat, Umat, b1, b2, b3 )
U3=ZERO U3=ZERO
IF(ABS(t0-oldt0).GE.tolw.AND.ini.GE.nsteps) THEN IF(ABS(t0-oldt0).GE.tolw.AND.ini.GE.nsteps) THEN
#ifdef __PARA
IF(me.EQ.1) THEN IF(me.EQ.1) THEN
#endif
WRITE(27,*) "MLWF Not generated after",ini,"Steps." WRITE(27,*) "MLWF Not generated after",ini,"Steps."
#ifdef __PARA
END IF END IF
#endif
IF(iprsta.GT.4) THEN IF(iprsta.GT.4) THEN
WRITE( stdout, * ) "MLWF Not generated after",ini,"Steps." WRITE( stdout, * ) "MLWF Not generated after",ini,"Steps."
END IF END IF
@ -1082,14 +1067,10 @@ SUBROUTINE ddyn( m, Omat, Umat, b1, b2, b3 )
spread=spread/m spread=spread/m
#ifdef __PARA
IF(me.EQ.1) THEN IF(me.EQ.1) THEN
#endif
WRITE(24, '(f10.7)') spread WRITE(24, '(f10.7)') spread
WRITE(27,*) "Average spread = ", spread WRITE(27,*) "Average spread = ", spread
#ifdef __PARA
END IF END IF
#endif
Omat=Oc Omat=Oc
IF(iprsta.GT.4) THEN IF(iprsta.GT.4) THEN
WRITE( stdout, * ) "Average spread = ", spread WRITE( stdout, * ) "Average spread = ", spread
@ -1236,9 +1217,8 @@ SUBROUTINE wfunc_init( clwf, b1, b2, b3, ibrav )
root_image, intra_image_comm, ierr) root_image, intra_image_comm, ierr)
IF (ierr.NE.0) CALL errore('wfunc_init','MPI_GATHERV' , ierr) IF (ierr.NE.0) CALL errore('wfunc_init','MPI_GATHERV' , ierr)
#endif #endif
#ifdef __PARA
IF(me.EQ.1) THEN IF(me.EQ.1) THEN
#endif
IF(clwf.EQ.5) THEN IF(clwf.EQ.5) THEN
#ifdef __PARA #ifdef __PARA
DO ii=1,ntot DO ii=1,ntot
@ -1251,9 +1231,7 @@ SUBROUTINE wfunc_init( clwf, b1, b2, b3, ibrav )
#endif #endif
CLOSE(21) CLOSE(21)
END IF END IF
#ifdef __PARA
END IF END IF
#endif
DO inw=1,nw1 DO inw=1,nw1
IF(i_1(inw).EQ.0.AND.j_1(inw).EQ.0) THEN IF(i_1(inw).EQ.0.AND.j_1(inw).EQ.0) THEN