2004-11-25 22:51:47 +08:00
|
|
|
!
|
2005-05-17 03:19:04 +08:00
|
|
|
! Copyright (C) 2002-2005 FPMD-CPV groups
|
2004-11-25 22:51:47 +08:00
|
|
|
! 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 .
|
|
|
|
!
|
2005-03-02 18:03:55 +08:00
|
|
|
!=----------------------------------------------------------------------------=!
|
|
|
|
MODULE electrons_module
|
|
|
|
!=----------------------------------------------------------------------------=!
|
General cleanup of intrinsic functions:
conversion to real => DBLE
(including real part of a complex number)
conversion to complex => CMPLX
complex conjugate => CONJG
imaginary part => AIMAG
All functions are uppercase.
CMPLX is preprocessed by f_defs.h and performs an explicit cast:
#define CMPLX(a,b) cmplx(a,b,kind=DP)
This implies that 1) f_defs.h must be included whenever a CMPLX is present,
2) CMPLX should stay in a single line, 3) DP must be defined.
All occurrences of real, float, dreal, dfloat, dconjg, dimag, dcmplx
removed - please do not reintroduce any of them.
Tested only with ifc7 and g95 - beware unintended side effects
Maybe not the best solution (explicit casts everywhere would be better)
but it can be easily changed with a script if the need arises.
The following code might be used to test for possible trouble:
program test_intrinsic
implicit none
integer, parameter :: dp = selected_real_kind(14,200)
real (kind=dp) :: a = 0.123456789012345_dp
real (kind=dp) :: b = 0.987654321098765_dp
complex (kind=dp) :: c = ( 0.123456789012345_dp, 0.987654321098765_dp)
print *, ' A = ', a
print *, ' DBLE(A)= ', DBLE(a)
print *, ' C = ', c
print *, 'CONJG(C)= ', CONJG(c)
print *, 'DBLE(c),AIMAG(C) = ', DBLE(c), AIMAG(c)
print *, 'CMPLX(A,B,kind=dp)= ', CMPLX( a, b, kind=dp)
end program test_intrinsic
Note that CMPLX and REAL without a cast yield single precision numbers on
ifc7 and g95 !!!
git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@2133 c92efa57-630b-4861-b058-cf58834340f0
2005-08-27 01:44:42 +08:00
|
|
|
#include "f_defs.h"
|
2004-11-25 22:51:47 +08:00
|
|
|
USE kinds
|
2005-05-19 05:01:05 +08:00
|
|
|
USE parameters, ONLY: nspinx
|
2005-03-02 18:03:55 +08:00
|
|
|
USE parallel_toolkit, ONLY: pdspev_drv, dspev_drv, pzhpev_drv, zhpev_drv
|
|
|
|
USE electrons_base, ONLY: nbnd, nbndx, nbsp, nbspx, nspin, nel, nelt, &
|
|
|
|
nupdwn, iupdwn, telectrons_base_initval, f
|
2004-11-25 22:51:47 +08:00
|
|
|
USE cp_electronic_mass, ONLY: ecutmass => emass_cutoff
|
|
|
|
USE cp_electronic_mass, ONLY: emass
|
|
|
|
USE cp_electronic_mass, ONLY: emass_precond
|
|
|
|
|
|
|
|
|
|
|
|
IMPLICIT NONE
|
|
|
|
SAVE
|
|
|
|
|
|
|
|
PRIVATE
|
|
|
|
|
|
|
|
! ... declare module-scope variables
|
|
|
|
|
|
|
|
LOGICAL :: band_first = .TRUE.
|
|
|
|
|
2005-04-15 05:08:53 +08:00
|
|
|
INTEGER :: n_emp = 0 ! number of empty states
|
2004-11-25 22:51:47 +08:00
|
|
|
|
2005-05-19 05:01:05 +08:00
|
|
|
INTEGER :: nb_l(nspinx) = 0 ! local number of states ( for each spin components )
|
|
|
|
INTEGER :: n_emp_l(nspinx) = 0
|
2004-11-25 22:51:47 +08:00
|
|
|
INTEGER, ALLOCATABLE :: ib_owner(:)
|
|
|
|
INTEGER, ALLOCATABLE :: ib_local(:)
|
|
|
|
|
2005-08-28 22:09:42 +08:00
|
|
|
REAL(DP), ALLOCATABLE :: ei(:,:,:)
|
|
|
|
REAL(DP), ALLOCATABLE :: ei_emp(:,:,:)
|
|
|
|
REAL(DP), ALLOCATABLE :: pmss(:)
|
2004-11-25 22:51:47 +08:00
|
|
|
|
|
|
|
! ... Fourier acceleration
|
|
|
|
|
|
|
|
LOGICAL :: toccrd = .FALSE. ! read occupation number from standard input
|
|
|
|
|
|
|
|
INTERFACE eigs
|
|
|
|
MODULE PROCEDURE rceigs
|
|
|
|
END INTERFACE
|
|
|
|
|
2004-12-21 23:48:19 +08:00
|
|
|
PUBLIC :: electrons_setup, eigs, cp_eigs
|
- FPMD: pseudopotential variable wsg, wnl, fnl substituted with
dion, beta, bec everyware.
- subroutines formfn, compute_beta, nlsm1, nlsm2, ecc ... now are common
between FPMD and CPV, a lot of clean ups!
- Changes in stdout: relevant physical quantities ( positions velocities an cell )
are now printed with the seme format of the corresponding input card,
like in PW, as was suggested by SdG.
- exemple23 updated to reflect the new input namelist "wannier"
- Subroutine init_run now is used in FPMD too.
- WARNING in the stress computed with CP, for a pseudo with core-corrections,
a contribution is missing! Not yet fixed, I need to talk with PG for the
box staff.
- WARNING the examples reference are not updated, I'm on the IBM sp, and
I prefer to update them from a linux machine.
git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@2110 c92efa57-630b-4861-b058-cf58834340f0
2005-08-22 22:14:13 +08:00
|
|
|
PUBLIC :: pmss_init, occn_init, bmeshset, occn_info
|
2004-11-25 22:51:47 +08:00
|
|
|
PUBLIC :: deallocate_electrons, fermi_energy
|
2005-04-15 05:08:53 +08:00
|
|
|
PUBLIC :: pmss, n_emp, emass, ei_emp, n_emp_l, ib_owner, ib_local, nb_l
|
|
|
|
PUBLIC :: ei, nspin, nelt, nupdwn
|
2004-11-25 22:51:47 +08:00
|
|
|
PUBLIC :: nbnd
|
2005-11-08 08:03:27 +08:00
|
|
|
PUBLIC :: print_eigenvalues
|
2004-11-25 22:51:47 +08:00
|
|
|
|
2005-03-02 18:03:55 +08:00
|
|
|
!
|
2004-11-25 22:51:47 +08:00
|
|
|
! end of module-scope declarations
|
2005-03-02 18:03:55 +08:00
|
|
|
!
|
|
|
|
!=----------------------------------------------------------------------------=!
|
|
|
|
CONTAINS
|
|
|
|
!=----------------------------------------------------------------------------=!
|
2004-11-25 22:51:47 +08:00
|
|
|
|
|
|
|
|
- FPMD: pseudopotential variable wsg, wnl, fnl substituted with
dion, beta, bec everyware.
- subroutines formfn, compute_beta, nlsm1, nlsm2, ecc ... now are common
between FPMD and CPV, a lot of clean ups!
- Changes in stdout: relevant physical quantities ( positions velocities an cell )
are now printed with the seme format of the corresponding input card,
like in PW, as was suggested by SdG.
- exemple23 updated to reflect the new input namelist "wannier"
- Subroutine init_run now is used in FPMD too.
- WARNING in the stress computed with CP, for a pseudo with core-corrections,
a contribution is missing! Not yet fixed, I need to talk with PG for the
box staff.
- WARNING the examples reference are not updated, I'm on the IBM sp, and
I prefer to update them from a linux machine.
git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@2110 c92efa57-630b-4861-b058-cf58834340f0
2005-08-22 22:14:13 +08:00
|
|
|
SUBROUTINE pmss_init( ema0bg, ngw )
|
|
|
|
!
|
2005-03-02 18:03:55 +08:00
|
|
|
! Calculate: PMSS = EMASS * (2PI/Alat)^2 * |G|^2 / ECUTMASS
|
- FPMD: pseudopotential variable wsg, wnl, fnl substituted with
dion, beta, bec everyware.
- subroutines formfn, compute_beta, nlsm1, nlsm2, ecc ... now are common
between FPMD and CPV, a lot of clean ups!
- Changes in stdout: relevant physical quantities ( positions velocities an cell )
are now printed with the seme format of the corresponding input card,
like in PW, as was suggested by SdG.
- exemple23 updated to reflect the new input namelist "wannier"
- Subroutine init_run now is used in FPMD too.
- WARNING in the stress computed with CP, for a pseudo with core-corrections,
a contribution is missing! Not yet fixed, I need to talk with PG for the
box staff.
- WARNING the examples reference are not updated, I'm on the IBM sp, and
I prefer to update them from a linux machine.
git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@2110 c92efa57-630b-4861-b058-cf58834340f0
2005-08-22 22:14:13 +08:00
|
|
|
!
|
2005-08-28 22:09:42 +08:00
|
|
|
REAL(DP), INTENT(IN) :: ema0bg(:)
|
2005-03-02 18:03:55 +08:00
|
|
|
INTEGER, INTENT(IN) :: ngw
|
|
|
|
INTEGER :: ierr
|
- FPMD: pseudopotential variable wsg, wnl, fnl substituted with
dion, beta, bec everyware.
- subroutines formfn, compute_beta, nlsm1, nlsm2, ecc ... now are common
between FPMD and CPV, a lot of clean ups!
- Changes in stdout: relevant physical quantities ( positions velocities an cell )
are now printed with the seme format of the corresponding input card,
like in PW, as was suggested by SdG.
- exemple23 updated to reflect the new input namelist "wannier"
- Subroutine init_run now is used in FPMD too.
- WARNING in the stress computed with CP, for a pseudo with core-corrections,
a contribution is missing! Not yet fixed, I need to talk with PG for the
box staff.
- WARNING the examples reference are not updated, I'm on the IBM sp, and
I prefer to update them from a linux machine.
git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@2110 c92efa57-630b-4861-b058-cf58834340f0
2005-08-22 22:14:13 +08:00
|
|
|
!
|
2005-03-02 18:03:55 +08:00
|
|
|
ALLOCATE( pmss( ngw ), STAT=ierr)
|
- FPMD: pseudopotential variable wsg, wnl, fnl substituted with
dion, beta, bec everyware.
- subroutines formfn, compute_beta, nlsm1, nlsm2, ecc ... now are common
between FPMD and CPV, a lot of clean ups!
- Changes in stdout: relevant physical quantities ( positions velocities an cell )
are now printed with the seme format of the corresponding input card,
like in PW, as was suggested by SdG.
- exemple23 updated to reflect the new input namelist "wannier"
- Subroutine init_run now is used in FPMD too.
- WARNING in the stress computed with CP, for a pseudo with core-corrections,
a contribution is missing! Not yet fixed, I need to talk with PG for the
box staff.
- WARNING the examples reference are not updated, I'm on the IBM sp, and
I prefer to update them from a linux machine.
git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@2110 c92efa57-630b-4861-b058-cf58834340f0
2005-08-22 22:14:13 +08:00
|
|
|
IF( ierr/=0 ) CALL errore( ' pmss_init ',' allocating pmss ', ierr)
|
|
|
|
!
|
|
|
|
pmss = emass / ema0bg
|
|
|
|
!
|
2005-03-02 18:03:55 +08:00
|
|
|
RETURN
|
- FPMD: pseudopotential variable wsg, wnl, fnl substituted with
dion, beta, bec everyware.
- subroutines formfn, compute_beta, nlsm1, nlsm2, ecc ... now are common
between FPMD and CPV, a lot of clean ups!
- Changes in stdout: relevant physical quantities ( positions velocities an cell )
are now printed with the seme format of the corresponding input card,
like in PW, as was suggested by SdG.
- exemple23 updated to reflect the new input namelist "wannier"
- Subroutine init_run now is used in FPMD too.
- WARNING in the stress computed with CP, for a pseudo with core-corrections,
a contribution is missing! Not yet fixed, I need to talk with PG for the
box staff.
- WARNING the examples reference are not updated, I'm on the IBM sp, and
I prefer to update them from a linux machine.
git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@2110 c92efa57-630b-4861-b058-cf58834340f0
2005-08-22 22:14:13 +08:00
|
|
|
END SUBROUTINE pmss_init
|
2004-11-25 22:51:47 +08:00
|
|
|
|
|
|
|
! ----------------------------------------------
|
|
|
|
! ----------------------------------------------
|
|
|
|
|
- FPMD: pseudopotential variable wsg, wnl, fnl substituted with
dion, beta, bec everyware.
- subroutines formfn, compute_beta, nlsm1, nlsm2, ecc ... now are common
between FPMD and CPV, a lot of clean ups!
- Changes in stdout: relevant physical quantities ( positions velocities an cell )
are now printed with the seme format of the corresponding input card,
like in PW, as was suggested by SdG.
- exemple23 updated to reflect the new input namelist "wannier"
- Subroutine init_run now is used in FPMD too.
- WARNING in the stress computed with CP, for a pseudo with core-corrections,
a contribution is missing! Not yet fixed, I need to talk with PG for the
box staff.
- WARNING the examples reference are not updated, I'm on the IBM sp, and
I prefer to update them from a linux machine.
git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@2110 c92efa57-630b-4861-b058-cf58834340f0
2005-08-22 22:14:13 +08:00
|
|
|
SUBROUTINE occn_init( occ )
|
2004-11-25 22:51:47 +08:00
|
|
|
|
|
|
|
! This subroutine fill in the input array with the
|
|
|
|
! occupations values read from input
|
|
|
|
|
|
|
|
USE io_global, ONLY: stdout, ionode
|
|
|
|
|
2005-08-28 22:09:42 +08:00
|
|
|
REAL(DP) :: occ(:,:,:)
|
2004-11-25 22:51:47 +08:00
|
|
|
INTEGER :: ik, i, nk, ispin
|
|
|
|
|
|
|
|
IF( SIZE( occ, 1 ) < nbnd ) &
|
- FPMD: pseudopotential variable wsg, wnl, fnl substituted with
dion, beta, bec everyware.
- subroutines formfn, compute_beta, nlsm1, nlsm2, ecc ... now are common
between FPMD and CPV, a lot of clean ups!
- Changes in stdout: relevant physical quantities ( positions velocities an cell )
are now printed with the seme format of the corresponding input card,
like in PW, as was suggested by SdG.
- exemple23 updated to reflect the new input namelist "wannier"
- Subroutine init_run now is used in FPMD too.
- WARNING in the stress computed with CP, for a pseudo with core-corrections,
a contribution is missing! Not yet fixed, I need to talk with PG for the
box staff.
- WARNING the examples reference are not updated, I'm on the IBM sp, and
I prefer to update them from a linux machine.
git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@2110 c92efa57-630b-4861-b058-cf58834340f0
2005-08-22 22:14:13 +08:00
|
|
|
CALL errore(' occn_init ',' wrong dimension ', 1)
|
2004-11-25 22:51:47 +08:00
|
|
|
IF( SIZE( occ, 3 ) < nspin ) &
|
- FPMD: pseudopotential variable wsg, wnl, fnl substituted with
dion, beta, bec everyware.
- subroutines formfn, compute_beta, nlsm1, nlsm2, ecc ... now are common
between FPMD and CPV, a lot of clean ups!
- Changes in stdout: relevant physical quantities ( positions velocities an cell )
are now printed with the seme format of the corresponding input card,
like in PW, as was suggested by SdG.
- exemple23 updated to reflect the new input namelist "wannier"
- Subroutine init_run now is used in FPMD too.
- WARNING in the stress computed with CP, for a pseudo with core-corrections,
a contribution is missing! Not yet fixed, I need to talk with PG for the
box staff.
- WARNING the examples reference are not updated, I'm on the IBM sp, and
I prefer to update them from a linux machine.
git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@2110 c92efa57-630b-4861-b058-cf58834340f0
2005-08-22 22:14:13 +08:00
|
|
|
CALL errore(' occn_init ',' wrong dimension ', 2)
|
2004-11-25 22:51:47 +08:00
|
|
|
|
|
|
|
nk = SIZE( occ, 2 )
|
|
|
|
occ = 0.0d0
|
- FPMD: pseudopotential variable wsg, wnl, fnl substituted with
dion, beta, bec everyware.
- subroutines formfn, compute_beta, nlsm1, nlsm2, ecc ... now are common
between FPMD and CPV, a lot of clean ups!
- Changes in stdout: relevant physical quantities ( positions velocities an cell )
are now printed with the seme format of the corresponding input card,
like in PW, as was suggested by SdG.
- exemple23 updated to reflect the new input namelist "wannier"
- Subroutine init_run now is used in FPMD too.
- WARNING in the stress computed with CP, for a pseudo with core-corrections,
a contribution is missing! Not yet fixed, I need to talk with PG for the
box staff.
- WARNING the examples reference are not updated, I'm on the IBM sp, and
I prefer to update them from a linux machine.
git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@2110 c92efa57-630b-4861-b058-cf58834340f0
2005-08-22 22:14:13 +08:00
|
|
|
!
|
2004-11-25 22:51:47 +08:00
|
|
|
IF( nspin == 1 ) THEN
|
|
|
|
DO ik = 1, nk
|
2005-03-02 18:03:55 +08:00
|
|
|
occ( 1:nbnd, ik, 1 ) = f( 1:nbnd )
|
2004-11-25 22:51:47 +08:00
|
|
|
END DO
|
2005-05-19 05:01:05 +08:00
|
|
|
ELSE IF( nspin == 2 ) THEN
|
2004-11-25 22:51:47 +08:00
|
|
|
DO ik = 1, nk
|
2005-03-02 18:03:55 +08:00
|
|
|
occ( 1:nupdwn(1), ik, 1 ) = f( 1:nupdwn(1) )
|
2004-11-25 22:51:47 +08:00
|
|
|
END DO
|
|
|
|
DO ik = 1, nk
|
2005-03-02 18:03:55 +08:00
|
|
|
occ( 1:nupdwn(2), ik, 2 ) = f( iupdwn(2) : ( iupdwn(2) + nupdwn(2) - 1 ) )
|
2004-11-25 22:51:47 +08:00
|
|
|
END DO
|
2005-05-19 05:01:05 +08:00
|
|
|
ELSE
|
|
|
|
WRITE( stdout, * ) ' nspin = ', nspin
|
- FPMD: pseudopotential variable wsg, wnl, fnl substituted with
dion, beta, bec everyware.
- subroutines formfn, compute_beta, nlsm1, nlsm2, ecc ... now are common
between FPMD and CPV, a lot of clean ups!
- Changes in stdout: relevant physical quantities ( positions velocities an cell )
are now printed with the seme format of the corresponding input card,
like in PW, as was suggested by SdG.
- exemple23 updated to reflect the new input namelist "wannier"
- Subroutine init_run now is used in FPMD too.
- WARNING in the stress computed with CP, for a pseudo with core-corrections,
a contribution is missing! Not yet fixed, I need to talk with PG for the
box staff.
- WARNING the examples reference are not updated, I'm on the IBM sp, and
I prefer to update them from a linux machine.
git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@2110 c92efa57-630b-4861-b058-cf58834340f0
2005-08-22 22:14:13 +08:00
|
|
|
CALL errore(' occn_init ',' nspin not implemented ', 3)
|
2004-11-25 22:51:47 +08:00
|
|
|
END IF
|
- FPMD: pseudopotential variable wsg, wnl, fnl substituted with
dion, beta, bec everyware.
- subroutines formfn, compute_beta, nlsm1, nlsm2, ecc ... now are common
between FPMD and CPV, a lot of clean ups!
- Changes in stdout: relevant physical quantities ( positions velocities an cell )
are now printed with the seme format of the corresponding input card,
like in PW, as was suggested by SdG.
- exemple23 updated to reflect the new input namelist "wannier"
- Subroutine init_run now is used in FPMD too.
- WARNING in the stress computed with CP, for a pseudo with core-corrections,
a contribution is missing! Not yet fixed, I need to talk with PG for the
box staff.
- WARNING the examples reference are not updated, I'm on the IBM sp, and
I prefer to update them from a linux machine.
git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@2110 c92efa57-630b-4861-b058-cf58834340f0
2005-08-22 22:14:13 +08:00
|
|
|
!
|
|
|
|
RETURN
|
|
|
|
END SUBROUTINE occn_init
|
|
|
|
|
2004-11-25 22:51:47 +08:00
|
|
|
|
- FPMD: pseudopotential variable wsg, wnl, fnl substituted with
dion, beta, bec everyware.
- subroutines formfn, compute_beta, nlsm1, nlsm2, ecc ... now are common
between FPMD and CPV, a lot of clean ups!
- Changes in stdout: relevant physical quantities ( positions velocities an cell )
are now printed with the seme format of the corresponding input card,
like in PW, as was suggested by SdG.
- exemple23 updated to reflect the new input namelist "wannier"
- Subroutine init_run now is used in FPMD too.
- WARNING in the stress computed with CP, for a pseudo with core-corrections,
a contribution is missing! Not yet fixed, I need to talk with PG for the
box staff.
- WARNING the examples reference are not updated, I'm on the IBM sp, and
I prefer to update them from a linux machine.
git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@2110 c92efa57-630b-4861-b058-cf58834340f0
2005-08-22 22:14:13 +08:00
|
|
|
SUBROUTINE occn_info( occ )
|
|
|
|
!
|
|
|
|
! This subroutine prints occupation numbers to stdout
|
|
|
|
!
|
|
|
|
USE io_global, ONLY: stdout, ionode
|
|
|
|
!
|
2005-08-28 22:09:42 +08:00
|
|
|
REAL(DP) :: occ(:,:,:)
|
- FPMD: pseudopotential variable wsg, wnl, fnl substituted with
dion, beta, bec everyware.
- subroutines formfn, compute_beta, nlsm1, nlsm2, ecc ... now are common
between FPMD and CPV, a lot of clean ups!
- Changes in stdout: relevant physical quantities ( positions velocities an cell )
are now printed with the seme format of the corresponding input card,
like in PW, as was suggested by SdG.
- exemple23 updated to reflect the new input namelist "wannier"
- Subroutine init_run now is used in FPMD too.
- WARNING in the stress computed with CP, for a pseudo with core-corrections,
a contribution is missing! Not yet fixed, I need to talk with PG for the
box staff.
- WARNING the examples reference are not updated, I'm on the IBM sp, and
I prefer to update them from a linux machine.
git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@2110 c92efa57-630b-4861-b058-cf58834340f0
2005-08-22 22:14:13 +08:00
|
|
|
INTEGER :: ik, i, nk, ispin
|
|
|
|
!
|
2004-11-25 22:51:47 +08:00
|
|
|
IF( ionode ) THEN
|
|
|
|
WRITE( stdout, fmt="(3X,'Occupation number from init')" )
|
|
|
|
IF( nspin == 1 ) THEN
|
|
|
|
WRITE( stdout, fmt = " (3X, 'nbnd = ', I5 ) " ) nbnd
|
|
|
|
WRITE( stdout, fmt = " (3X,10F5.2)" ) ( occ( i, 1, 1 ), i = 1, nbnd )
|
|
|
|
ELSE
|
|
|
|
DO ispin = 1, nspin
|
|
|
|
WRITE( stdout, fmt = " (3X,'spin = ', I3, ' nbnd = ', I5 ) " ) ispin, nupdwn( ispin )
|
|
|
|
WRITE( stdout, fmt = " (3X,10F5.2)" ) ( occ( i, 1, ispin ), i = 1, nupdwn( ispin ) )
|
|
|
|
END DO
|
|
|
|
END IF
|
|
|
|
END IF
|
- FPMD: pseudopotential variable wsg, wnl, fnl substituted with
dion, beta, bec everyware.
- subroutines formfn, compute_beta, nlsm1, nlsm2, ecc ... now are common
between FPMD and CPV, a lot of clean ups!
- Changes in stdout: relevant physical quantities ( positions velocities an cell )
are now printed with the seme format of the corresponding input card,
like in PW, as was suggested by SdG.
- exemple23 updated to reflect the new input namelist "wannier"
- Subroutine init_run now is used in FPMD too.
- WARNING in the stress computed with CP, for a pseudo with core-corrections,
a contribution is missing! Not yet fixed, I need to talk with PG for the
box staff.
- WARNING the examples reference are not updated, I'm on the IBM sp, and
I prefer to update them from a linux machine.
git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@2110 c92efa57-630b-4861-b058-cf58834340f0
2005-08-22 22:14:13 +08:00
|
|
|
!
|
2004-11-25 22:51:47 +08:00
|
|
|
RETURN
|
- FPMD: pseudopotential variable wsg, wnl, fnl substituted with
dion, beta, bec everyware.
- subroutines formfn, compute_beta, nlsm1, nlsm2, ecc ... now are common
between FPMD and CPV, a lot of clean ups!
- Changes in stdout: relevant physical quantities ( positions velocities an cell )
are now printed with the seme format of the corresponding input card,
like in PW, as was suggested by SdG.
- exemple23 updated to reflect the new input namelist "wannier"
- Subroutine init_run now is used in FPMD too.
- WARNING in the stress computed with CP, for a pseudo with core-corrections,
a contribution is missing! Not yet fixed, I need to talk with PG for the
box staff.
- WARNING the examples reference are not updated, I'm on the IBM sp, and
I prefer to update them from a linux machine.
git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@2110 c92efa57-630b-4861-b058-cf58834340f0
2005-08-22 22:14:13 +08:00
|
|
|
END SUBROUTINE occn_info
|
2004-11-25 22:51:47 +08:00
|
|
|
|
|
|
|
! ----------------------------------------------
|
|
|
|
! ----------------------------------------------
|
|
|
|
|
|
|
|
SUBROUTINE bmeshset
|
|
|
|
|
2005-04-15 05:08:53 +08:00
|
|
|
! This subroutine initialize the variables for the
|
2004-11-25 22:51:47 +08:00
|
|
|
! distribution across processors of the overlap matrixes
|
|
|
|
! of sizes ( nx, nx )
|
|
|
|
|
|
|
|
USE mp_global, ONLY: mpime, nproc
|
|
|
|
|
|
|
|
IMPLICIT NONE
|
|
|
|
|
2005-04-22 23:23:19 +08:00
|
|
|
INTEGER :: i, ierr
|
2004-11-25 22:51:47 +08:00
|
|
|
|
|
|
|
IF( band_first ) THEN
|
|
|
|
CALL errore(' bmeshset ',' module not initialized ',0)
|
|
|
|
END IF
|
|
|
|
|
2005-04-15 05:08:53 +08:00
|
|
|
DO i = 1, nspin
|
2005-05-19 05:01:05 +08:00
|
|
|
IF( i > nspinx ) CALL errore( ' bmeshset ',' spin too large ', i)
|
2005-04-15 05:08:53 +08:00
|
|
|
nb_l( i ) = nupdwn( i ) / nproc
|
|
|
|
IF( mpime < MOD( nupdwn( i ), nproc ) ) nb_l( i ) = nb_l( i ) + 1
|
|
|
|
n_emp_l( i ) = n_emp / nproc
|
|
|
|
IF( mpime < MOD( n_emp, nproc ) ) n_emp_l( i ) = n_emp_l( i ) + 1
|
|
|
|
END DO
|
2004-11-25 22:51:47 +08:00
|
|
|
|
2005-04-22 23:23:19 +08:00
|
|
|
IF( ALLOCATED( ib_owner ) ) DEALLOCATE( ib_owner )
|
2004-11-25 22:51:47 +08:00
|
|
|
ALLOCATE( ib_owner( nbndx ), STAT=ierr)
|
|
|
|
IF( ierr/=0 ) CALL errore( ' bmeshset ',' allocating ib_owner ', ierr)
|
2005-04-22 23:23:19 +08:00
|
|
|
IF( ALLOCATED( ib_local ) ) DEALLOCATE( ib_local )
|
2004-11-25 22:51:47 +08:00
|
|
|
ALLOCATE( ib_local( nbndx ), STAT=ierr)
|
|
|
|
IF( ierr/=0 ) CALL errore( ' bmeshset ',' allocating ib_local ', ierr)
|
|
|
|
|
|
|
|
! here define the association between processors and electronic states
|
|
|
|
! round robin distribution is used
|
|
|
|
|
|
|
|
ib_local = 0
|
|
|
|
ib_owner = -1
|
|
|
|
DO i = 1, nbndx
|
2005-04-15 05:08:53 +08:00
|
|
|
ib_local( i ) = ( i - 1 ) / nproc ! local index of the i-th band
|
|
|
|
ib_owner( i ) = MOD( ( i - 1 ), nproc ) ! owner of th i-th band
|
2004-11-25 22:51:47 +08:00
|
|
|
IF( mpime <= ib_owner( i ) ) THEN
|
|
|
|
ib_local( i ) = ib_local( i ) + 1
|
|
|
|
END IF
|
|
|
|
END DO
|
|
|
|
|
|
|
|
RETURN
|
|
|
|
END SUBROUTINE bmeshset
|
|
|
|
|
|
|
|
! ----------------------------------------------
|
2005-03-02 18:03:55 +08:00
|
|
|
!
|
|
|
|
!
|
|
|
|
!
|
2004-11-25 22:51:47 +08:00
|
|
|
! ----------------------------------------------
|
|
|
|
|
2005-03-02 18:03:55 +08:00
|
|
|
|
|
|
|
SUBROUTINE electrons_setup( n_emp_ , emass_inp, ecutmass_inp, nkp )
|
2004-11-25 22:51:47 +08:00
|
|
|
|
|
|
|
IMPLICIT NONE
|
|
|
|
INTEGER, INTENT(IN) :: n_emp_
|
2005-08-28 22:09:42 +08:00
|
|
|
REAL(DP), INTENT(IN) :: emass_inp, ecutmass_inp
|
2004-11-25 22:51:47 +08:00
|
|
|
INTEGER, INTENT(IN) :: nkp
|
|
|
|
INTEGER :: ierr, i
|
|
|
|
|
|
|
|
|
2005-03-02 18:03:55 +08:00
|
|
|
IF( .NOT. telectrons_base_initval ) &
|
|
|
|
CALL errore( ' electrons_setup ', ' electrons_base not initialized ', 1 )
|
2004-11-25 22:51:47 +08:00
|
|
|
|
|
|
|
n_emp = n_emp_
|
|
|
|
|
2005-03-02 18:03:55 +08:00
|
|
|
IF( n_emp > nbndx ) &
|
|
|
|
CALL errore( ' electrons_setup ', ' too many empty states ', 1 )
|
2004-11-25 22:51:47 +08:00
|
|
|
|
2005-03-02 18:03:55 +08:00
|
|
|
IF( ALLOCATED( ei ) ) DEALLOCATE( ei )
|
2004-11-25 22:51:47 +08:00
|
|
|
ALLOCATE( ei( nbnd, nkp, nspin ), STAT=ierr)
|
|
|
|
IF( ierr/=0 ) CALL errore( ' electrons ',' allocating ei ',ierr)
|
2005-08-28 22:09:42 +08:00
|
|
|
ei = 0.0_DP
|
2004-11-25 22:51:47 +08:00
|
|
|
|
2005-03-02 18:03:55 +08:00
|
|
|
IF( ALLOCATED( ei_emp ) ) DEALLOCATE( ei_emp )
|
2004-11-25 22:51:47 +08:00
|
|
|
IF( n_emp > 0 ) THEN
|
|
|
|
ALLOCATE( ei_emp( n_emp, nkp, nspin ), STAT=ierr)
|
|
|
|
IF( ierr/=0 ) CALL errore( ' electrons ',' allocating ei_emp ',ierr)
|
2005-08-28 22:09:42 +08:00
|
|
|
ei_emp = 0.0_DP
|
2004-11-25 22:51:47 +08:00
|
|
|
END IF
|
|
|
|
|
|
|
|
ecutmass = ecutmass_inp
|
|
|
|
emass = emass_inp
|
2005-08-28 22:09:42 +08:00
|
|
|
IF ( ecutmass < 0.0_DP ) &
|
2004-11-25 22:51:47 +08:00
|
|
|
CALL errore(' electrons ',' ecutmass out of range ' , 0)
|
|
|
|
|
|
|
|
band_first = .FALSE.
|
|
|
|
|
|
|
|
RETURN
|
|
|
|
END SUBROUTINE electrons_setup
|
|
|
|
|
|
|
|
|
2005-11-08 08:03:27 +08:00
|
|
|
! ----------------------------------------------
|
|
|
|
|
|
|
|
|
|
|
|
SUBROUTINE print_eigenvalues( ei_unit, tfile, nfi, tps )
|
|
|
|
!
|
|
|
|
use constants, only : au
|
|
|
|
USE io_global, ONLY : stdout, ionode
|
|
|
|
!
|
|
|
|
INTEGER, INTENT(IN) :: ei_unit
|
|
|
|
LOGICAL, INTENT(IN) :: tfile
|
|
|
|
INTEGER, INTENT(IN) :: nfi
|
|
|
|
REAL(DP), INTENT(IN) :: tps
|
|
|
|
!
|
|
|
|
INTEGER :: ik, i, j, nkpt
|
|
|
|
!
|
|
|
|
nkpt = 1
|
|
|
|
!
|
|
|
|
IF ( tfile ) THEN
|
|
|
|
WRITE(ei_unit,30) nfi, tps
|
|
|
|
END IF
|
|
|
|
!
|
|
|
|
DO ik = 1, nkpt
|
|
|
|
!
|
|
|
|
DO j = 1, nspin
|
|
|
|
!
|
|
|
|
WRITE( stdout,1002) ik, j
|
|
|
|
WRITE( stdout,1004) ( ei( i, ik, j ) * au, i = 1, nupdwn(j) )
|
|
|
|
!
|
|
|
|
IF( n_emp .GT. 0 ) THEN
|
|
|
|
WRITE( stdout,1005) ik, j
|
|
|
|
WRITE( stdout,1004) ( ei_emp( i, ik, j ) * au , i = 1, n_emp )
|
|
|
|
WRITE( stdout,1006) ( ei_emp( 1, ik, j ) - ei( nupdwn(j), ik, j ) ) * au
|
|
|
|
END IF
|
|
|
|
!
|
|
|
|
IF( tfile ) THEN
|
|
|
|
WRITE(ei_unit,1010) ik, j
|
|
|
|
WRITE(ei_unit,1020) ( ei( i, ik, j ) * au, i = 1, nupdwn(j) )
|
|
|
|
IF( n_emp .GT. 0 ) THEN
|
|
|
|
WRITE(ei_unit,1011) ik, j
|
|
|
|
WRITE(ei_unit,1020) ( ei_emp( i, ik, j ) * au , i = 1, n_emp )
|
|
|
|
WRITE(ei_unit,1021) ( ei_emp( 1, ik, j ) - ei( nupdwn(j), ik, j ) ) * au
|
|
|
|
END IF
|
|
|
|
END IF
|
|
|
|
!
|
|
|
|
END DO
|
|
|
|
!
|
|
|
|
END DO
|
|
|
|
!
|
|
|
|
30 FORMAT(2X,'STEP:',I7,1X,F10.2)
|
|
|
|
1002 FORMAT(/,3X,'Eigenvalues (eV), kp = ',I3, ' , spin = ',I2,/)
|
|
|
|
1005 FORMAT(/,3X,'Empty States Eigenvalues (eV), kp = ',I3, ' , spin = ',I2,/)
|
|
|
|
1004 FORMAT(10F8.2)
|
|
|
|
1006 FORMAT(/,3X,'Electronic Gap (eV) = ',F8.2,/)
|
|
|
|
1010 FORMAT(3X,'Eigenvalues (eV), kp = ',I3, ' , spin = ',I2)
|
|
|
|
1011 FORMAT(3X,'Empty States Eigenvalues (eV), kp = ',I3, ' , spin = ',I2)
|
|
|
|
1020 FORMAT(10F8.2)
|
|
|
|
1021 FORMAT(3X,'Electronic Gap (eV) = ',F8.2)
|
|
|
|
1030 FORMAT(3X,'nfill = ', I4, ', nempt = ', I4, ', kp = ', I3, ', spin = ',I2)
|
|
|
|
!
|
|
|
|
RETURN
|
|
|
|
END SUBROUTINE print_eigenvalues
|
|
|
|
|
|
|
|
|
2004-11-25 22:51:47 +08:00
|
|
|
!=======================================================================
|
|
|
|
|
|
|
|
SUBROUTINE rceigs( nei, gam, cgam, tortho, f, ei, gamma_symmetry )
|
|
|
|
|
|
|
|
USE mp, ONLY: mp_sum
|
|
|
|
USE mp_global, ONLY: mpime, nproc, group
|
|
|
|
USE energies, only: eig_total_energy
|
|
|
|
USE constants, only: au
|
|
|
|
|
|
|
|
!OMPUTES:IF (THORTO)
|
|
|
|
! COMPUTES THE EIGENVALUES OF THE COMPLEX HERMITIAN MATRIX GAM
|
|
|
|
! THE EIGENVALUES OF GAMMA ARE PRINTED OUT IN ELECTRON VOLTS.
|
|
|
|
! ELSE
|
|
|
|
! THE EIGENVALUES ARE CALCULATED IN MAIN AS <PSI|H|PSI>, PASSED
|
|
|
|
! IN ei() AND PRINTED OUT IN EELECTRON VOLTS.
|
|
|
|
! END IF
|
|
|
|
!
|
|
|
|
|
|
|
|
|
|
|
|
! ... ARGUMENTS
|
2005-08-28 22:09:42 +08:00
|
|
|
REAL(DP), INTENT(IN) :: f(:)
|
2004-11-25 22:51:47 +08:00
|
|
|
LOGICAL, INTENT(IN) :: tortho, gamma_symmetry
|
2005-08-28 22:09:42 +08:00
|
|
|
REAL(DP), INTENT(INOUT) :: gam(:,:)
|
|
|
|
COMPLEX(DP), INTENT(INOUT) :: cgam(:,:)
|
|
|
|
REAL(DP) :: ei(:)
|
2004-11-25 22:51:47 +08:00
|
|
|
INTEGER, INTENT(IN) :: nei
|
|
|
|
|
|
|
|
|
|
|
|
! ... LOCALS
|
|
|
|
INTEGER :: i, nrl, n, ierr
|
|
|
|
INTEGER, ALLOCATABLE :: index(:)
|
2005-08-28 22:09:42 +08:00
|
|
|
REAL(DP), ALLOCATABLE :: ftmp(:)
|
2004-11-25 22:51:47 +08:00
|
|
|
|
2005-08-28 22:09:42 +08:00
|
|
|
REAL(DP), ALLOCATABLE :: vv(:,:)
|
|
|
|
REAL(DP), ALLOCATABLE :: aux(:)
|
|
|
|
REAL(DP), ALLOCATABLE :: g(:,:)
|
|
|
|
COMPLEX(DP), ALLOCATABLE :: cg(:,:)
|
|
|
|
COMPLEX(DP), ALLOCATABLE :: caux(:)
|
2004-11-25 22:51:47 +08:00
|
|
|
!
|
|
|
|
! ... SUBROUTINE BODY
|
|
|
|
!
|
|
|
|
|
|
|
|
IF( nei < 1 ) THEN
|
|
|
|
IF( SIZE( ei ) > 1 ) ei = 0.0d0
|
|
|
|
RETURN
|
|
|
|
END IF
|
|
|
|
|
|
|
|
n = nei
|
2005-04-15 05:08:53 +08:00
|
|
|
nrl = n / nproc
|
|
|
|
IF( mpime < MOD( n, nproc ) ) nrl = nrl + 1
|
|
|
|
|
2004-11-25 22:51:47 +08:00
|
|
|
IF ( gamma_symmetry ) THEN
|
|
|
|
IF( n > SIZE( gam, 2 ) ) CALL errore( ' eigs ',' n and gam inconsistent dimensions ',n )
|
|
|
|
ELSE
|
|
|
|
IF( n > SIZE( cgam, 2 ) ) CALL errore( ' eigs ',' n and cgam inconsistent dimensions ',n )
|
|
|
|
END IF
|
|
|
|
|
|
|
|
IF( n < 1 ) CALL errore( ' eigs ',' n wrong value ',n )
|
|
|
|
IF( n > SIZE( f ) ) CALL errore( ' eigs ',' n and f inconsistent dimensions ',n )
|
2005-04-15 05:08:53 +08:00
|
|
|
IF( nrl < 1 ) CALL errore( ' eigs ',' nrl wrong value ',nrl )
|
|
|
|
IF( nrl > SIZE( f ) ) CALL errore( ' eigs ',' nrl and f inconsistent dimensions ',n )
|
2004-11-25 22:51:47 +08:00
|
|
|
|
|
|
|
ALLOCATE( ftmp( n ), STAT=ierr )
|
|
|
|
IF( ierr/=0 ) CALL errore( ' eigs ',' allocating ftmp ',ierr )
|
|
|
|
ftmp = f( 1:n )
|
|
|
|
WHERE ( ftmp < 1.d-6 ) ftmp = 1.d-6
|
|
|
|
|
|
|
|
IF ( gamma_symmetry ) THEN
|
|
|
|
ALLOCATE( g(nrl,n), STAT=ierr)
|
|
|
|
IF( ierr/=0 ) CALL errore( ' eigs ',' allocating g ',ierr )
|
|
|
|
g = gam(1:nrl,1:n)
|
|
|
|
ELSE
|
|
|
|
ALLOCATE(cg(nrl,n), STAT=ierr)
|
|
|
|
IF( ierr/=0 ) CALL errore( ' eigs ',' allocating cg ',ierr )
|
|
|
|
cg = cgam(1:nrl,1:n)
|
|
|
|
END IF
|
|
|
|
|
|
|
|
IF (tortho) THEN
|
|
|
|
|
|
|
|
IF( gamma_symmetry ) THEN
|
|
|
|
IF ( ( nproc < 2 ) .OR. ( n < nproc ) ) THEN
|
|
|
|
ALLOCATE( aux( n*(n+1)/2 ), STAT=ierr)
|
|
|
|
IF( ierr/=0 ) CALL errore( ' eigs ',' allocating aux ',ierr )
|
|
|
|
! debug
|
|
|
|
!WRITE( 6, * )
|
|
|
|
!WRITE( 6, * ) ' <psi|H|psi> '
|
|
|
|
!DO i = 1, SIZE( g, 2 )
|
|
|
|
! WRITE( 6, fmt='(10D12.4)' ) g( :, i )
|
|
|
|
!END DO
|
|
|
|
!WRITE( 6, * )
|
|
|
|
CALL rpackgam( g, ftmp(:), aux )
|
|
|
|
CALL dspev_drv( 'N', 'L', n, aux, ei, g, n )
|
|
|
|
DEALLOCATE(aux, STAT=ierr)
|
|
|
|
IF( ierr/=0 ) CALL errore( ' eigs ',' deallocating aux ',ierr )
|
|
|
|
ELSE
|
|
|
|
CALL rpackgam( g, ftmp(:) )
|
|
|
|
ALLOCATE( vv(nrl,n), STAT=ierr)
|
|
|
|
IF( ierr/=0 ) CALL errore( ' eigs ',' allocating vv ',ierr )
|
|
|
|
CALL pdspev_drv('N', g, nrl, ei, vv, nrl, nrl, n, nproc, mpime)
|
|
|
|
DEALLOCATE( vv, STAT=ierr)
|
|
|
|
IF( ierr/=0 ) CALL errore( ' eigs ',' deallocating vv ',ierr )
|
|
|
|
END IF
|
|
|
|
ELSE
|
|
|
|
IF ( (nproc < 2) .OR. (n < nproc) ) THEN
|
|
|
|
ALLOCATE(caux(n*(n+1)/2), STAT=ierr)
|
|
|
|
IF( ierr/=0 ) CALL errore( ' eigs ',' allocating caux ',ierr )
|
|
|
|
CALL cpackgam( cg, ftmp(:), caux )
|
|
|
|
CALL zhpev_drv( 'N', 'L', n, caux, ei, cg, n )
|
|
|
|
DEALLOCATE(caux, STAT=ierr)
|
|
|
|
IF( ierr/=0 ) CALL errore( ' eigs ',' deallocating caux ',ierr )
|
|
|
|
ELSE
|
|
|
|
ALLOCATE(caux(1), STAT=ierr)
|
|
|
|
IF( ierr/=0 ) CALL errore( ' eigs ',' allocating caux ',ierr )
|
|
|
|
CALL cpackgam( cg, ftmp(:) )
|
|
|
|
CALL pzhpev_drv('N', cg, nrl, ei, caux, nrl, nrl, n, nproc, mpime)
|
|
|
|
DEALLOCATE(caux, STAT=ierr)
|
|
|
|
IF( ierr/=0 ) CALL errore( ' eigs ',' deallocating caux ',ierr )
|
|
|
|
END IF
|
|
|
|
END IF
|
|
|
|
|
|
|
|
ELSE
|
|
|
|
|
|
|
|
ALLOCATE(index(n), STAT=ierr)
|
|
|
|
IF( ierr/=0 ) CALL errore( ' eigs ',' allocating index ',ierr )
|
2005-08-28 22:09:42 +08:00
|
|
|
ei = 0.0_DP
|
2004-11-25 22:51:47 +08:00
|
|
|
DO i = 1, n
|
|
|
|
IF ( ib_owner(i) == mpime ) THEN
|
|
|
|
IF ( gamma_symmetry ) THEN
|
|
|
|
ei(i) = gam(ib_local(i),i) / ftmp(i)
|
|
|
|
ELSE
|
General cleanup of intrinsic functions:
conversion to real => DBLE
(including real part of a complex number)
conversion to complex => CMPLX
complex conjugate => CONJG
imaginary part => AIMAG
All functions are uppercase.
CMPLX is preprocessed by f_defs.h and performs an explicit cast:
#define CMPLX(a,b) cmplx(a,b,kind=DP)
This implies that 1) f_defs.h must be included whenever a CMPLX is present,
2) CMPLX should stay in a single line, 3) DP must be defined.
All occurrences of real, float, dreal, dfloat, dconjg, dimag, dcmplx
removed - please do not reintroduce any of them.
Tested only with ifc7 and g95 - beware unintended side effects
Maybe not the best solution (explicit casts everywhere would be better)
but it can be easily changed with a script if the need arises.
The following code might be used to test for possible trouble:
program test_intrinsic
implicit none
integer, parameter :: dp = selected_real_kind(14,200)
real (kind=dp) :: a = 0.123456789012345_dp
real (kind=dp) :: b = 0.987654321098765_dp
complex (kind=dp) :: c = ( 0.123456789012345_dp, 0.987654321098765_dp)
print *, ' A = ', a
print *, ' DBLE(A)= ', DBLE(a)
print *, ' C = ', c
print *, 'CONJG(C)= ', CONJG(c)
print *, 'DBLE(c),AIMAG(C) = ', DBLE(c), AIMAG(c)
print *, 'CMPLX(A,B,kind=dp)= ', CMPLX( a, b, kind=dp)
end program test_intrinsic
Note that CMPLX and REAL without a cast yield single precision numbers on
ifc7 and g95 !!!
git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@2133 c92efa57-630b-4861-b058-cf58834340f0
2005-08-27 01:44:42 +08:00
|
|
|
ei(i) = DBLE(cgam(ib_local(i),i)) / ftmp(i)
|
2004-11-25 22:51:47 +08:00
|
|
|
END IF
|
|
|
|
END IF
|
|
|
|
END DO
|
|
|
|
CALL mp_sum(ei,group)
|
|
|
|
index(1) = 0
|
|
|
|
CALL hpsort(n, ei, index)
|
|
|
|
DEALLOCATE(index, STAT=ierr)
|
|
|
|
IF( ierr/=0 ) CALL errore( ' eigs ',' deallocating index ',ierr )
|
|
|
|
|
|
|
|
END IF
|
|
|
|
|
|
|
|
DEALLOCATE(ftmp, STAT=ierr)
|
|
|
|
IF( ierr/=0 ) CALL errore( ' eigs ',' deallocating ftmp ',ierr )
|
|
|
|
IF (gamma_symmetry) THEN
|
|
|
|
DEALLOCATE(g, STAT=ierr)
|
|
|
|
IF( ierr/=0 ) CALL errore( ' eigs ',' deallocating g ',ierr )
|
|
|
|
! gam(1:nrl,1:n) = g
|
|
|
|
ELSE
|
|
|
|
DEALLOCATE(cg, STAT=ierr)
|
|
|
|
IF( ierr/=0 ) CALL errore( ' eigs ',' deallocating cg ',ierr )
|
|
|
|
! cgam(1:nrl,1:n) cg
|
|
|
|
END IF
|
|
|
|
|
|
|
|
RETURN
|
2005-05-18 16:49:38 +08:00
|
|
|
END SUBROUTINE rceigs
|
2004-11-25 22:51:47 +08:00
|
|
|
|
|
|
|
|
|
|
|
! ----------------------------------------------
|
|
|
|
|
|
|
|
SUBROUTINE deallocate_electrons
|
|
|
|
INTEGER :: ierr
|
|
|
|
IF(ALLOCATED(pmss)) THEN
|
|
|
|
DEALLOCATE(pmss, STAT=ierr)
|
|
|
|
IF( ierr/=0 ) CALL errore( ' deallocate_electrons ',' deallocating pmss ',ierr )
|
|
|
|
END IF
|
|
|
|
IF(ALLOCATED(ei)) THEN
|
|
|
|
DEALLOCATE(ei, STAT=ierr)
|
|
|
|
IF( ierr/=0 ) CALL errore( ' deallocate_electrons ',' deallocating ei ',ierr )
|
|
|
|
END IF
|
|
|
|
IF(ALLOCATED(ei_emp)) THEN
|
|
|
|
DEALLOCATE(ei_emp, STAT=ierr)
|
|
|
|
IF( ierr/=0 ) CALL errore( ' deallocate_electrons ',' deallocating ei_emp ',ierr )
|
|
|
|
END IF
|
|
|
|
IF(ALLOCATED(ib_owner)) THEN
|
|
|
|
DEALLOCATE(ib_owner, STAT=ierr)
|
|
|
|
IF( ierr/=0 ) CALL errore( ' deallocate_electrons ',' deallocating ib_owner ',ierr )
|
|
|
|
END IF
|
|
|
|
IF(ALLOCATED(ib_local)) THEN
|
|
|
|
DEALLOCATE(ib_local, STAT=ierr)
|
|
|
|
IF( ierr/=0 ) CALL errore( ' deallocate_electrons ',' deallocating ib_local ',ierr )
|
|
|
|
END IF
|
|
|
|
RETURN
|
|
|
|
END SUBROUTINE deallocate_electrons
|
|
|
|
|
|
|
|
|
|
|
|
! ----------------------------------------------
|
2005-03-02 18:03:55 +08:00
|
|
|
!
|
|
|
|
! tools subroutines
|
|
|
|
!
|
|
|
|
! ----------------------------------------------
|
|
|
|
|
|
|
|
|
2004-11-25 22:51:47 +08:00
|
|
|
SUBROUTINE cpackgam(cgam, f, caux)
|
|
|
|
USE mp_global, ONLY: mpime, nproc, group
|
|
|
|
USE mp, ONLY: mp_sum
|
|
|
|
IMPLICIT NONE
|
2005-08-28 22:09:42 +08:00
|
|
|
COMPLEX(DP), INTENT(INOUT) :: cgam(:,:)
|
|
|
|
COMPLEX(DP), INTENT(OUT), OPTIONAL :: caux(:)
|
|
|
|
REAL(DP), INTENT(IN) :: f(:)
|
2004-11-25 22:51:47 +08:00
|
|
|
INTEGER n, nrl, i, j, k, jl
|
|
|
|
nrl = SIZE(cgam, 1)
|
|
|
|
n = SIZE(cgam, 2)
|
|
|
|
IF( PRESENT( caux ) ) THEN
|
General cleanup of intrinsic functions:
conversion to real => DBLE
(including real part of a complex number)
conversion to complex => CMPLX
complex conjugate => CONJG
imaginary part => AIMAG
All functions are uppercase.
CMPLX is preprocessed by f_defs.h and performs an explicit cast:
#define CMPLX(a,b) cmplx(a,b,kind=DP)
This implies that 1) f_defs.h must be included whenever a CMPLX is present,
2) CMPLX should stay in a single line, 3) DP must be defined.
All occurrences of real, float, dreal, dfloat, dconjg, dimag, dcmplx
removed - please do not reintroduce any of them.
Tested only with ifc7 and g95 - beware unintended side effects
Maybe not the best solution (explicit casts everywhere would be better)
but it can be easily changed with a script if the need arises.
The following code might be used to test for possible trouble:
program test_intrinsic
implicit none
integer, parameter :: dp = selected_real_kind(14,200)
real (kind=dp) :: a = 0.123456789012345_dp
real (kind=dp) :: b = 0.987654321098765_dp
complex (kind=dp) :: c = ( 0.123456789012345_dp, 0.987654321098765_dp)
print *, ' A = ', a
print *, ' DBLE(A)= ', DBLE(a)
print *, ' C = ', c
print *, 'CONJG(C)= ', CONJG(c)
print *, 'DBLE(c),AIMAG(C) = ', DBLE(c), AIMAG(c)
print *, 'CMPLX(A,B,kind=dp)= ', CMPLX( a, b, kind=dp)
end program test_intrinsic
Note that CMPLX and REAL without a cast yield single precision numbers on
ifc7 and g95 !!!
git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@2133 c92efa57-630b-4861-b058-cf58834340f0
2005-08-27 01:44:42 +08:00
|
|
|
caux = CMPLX(0.0d0, 0.d0)
|
2004-11-25 22:51:47 +08:00
|
|
|
IF( mpime < n ) THEN
|
|
|
|
DO i = 1, n
|
|
|
|
j = mpime + 1
|
|
|
|
DO jl = 1, nrl
|
|
|
|
IF( j >= i ) THEN
|
|
|
|
! maps (j,i) index to low-tri packed (k) index
|
|
|
|
k = (i-1)*n + j - i*(i-1)/2
|
|
|
|
caux(k) = cgam(jl,i) / f(j)
|
|
|
|
END IF
|
|
|
|
j = j + nproc
|
|
|
|
END DO
|
|
|
|
END DO
|
|
|
|
END IF
|
|
|
|
CALL mp_sum(caux, group)
|
|
|
|
ELSE
|
|
|
|
IF( mpime < n ) THEN
|
|
|
|
DO i = 1, n
|
|
|
|
j = mpime + 1
|
|
|
|
DO jl = 1, nrl
|
|
|
|
cgam( jl, i ) = cgam( jl, i ) / f(j)
|
|
|
|
j = j + nproc
|
|
|
|
END DO
|
|
|
|
END DO
|
|
|
|
END IF
|
|
|
|
END IF
|
|
|
|
RETURN
|
2005-05-18 16:49:38 +08:00
|
|
|
END SUBROUTINE cpackgam
|
2004-11-25 22:51:47 +08:00
|
|
|
|
2005-03-02 18:03:55 +08:00
|
|
|
! ----------------------------------------------
|
|
|
|
|
2004-11-25 22:51:47 +08:00
|
|
|
SUBROUTINE rpackgam(gam, f, aux)
|
|
|
|
USE mp_global, ONLY: mpime, nproc, group
|
|
|
|
USE mp, ONLY: mp_sum
|
|
|
|
IMPLICIT NONE
|
2005-08-28 22:09:42 +08:00
|
|
|
REAL(DP), INTENT(INOUT) :: gam(:,:)
|
|
|
|
REAL(DP), INTENT(OUT), OPTIONAL :: aux(:)
|
|
|
|
REAL(DP), INTENT(IN) :: f(:)
|
2004-11-25 22:51:47 +08:00
|
|
|
INTEGER n, nrl, i, j, k, jl
|
|
|
|
nrl = SIZE(gam, 1)
|
|
|
|
n = SIZE(gam, 2)
|
|
|
|
IF( PRESENT( aux ) ) THEN
|
|
|
|
aux = 0.0d0
|
|
|
|
IF( mpime < n ) THEN
|
|
|
|
DO i = 1, n
|
|
|
|
j = mpime + 1
|
|
|
|
DO jl = 1, nrl
|
|
|
|
IF( j >= i ) THEN
|
|
|
|
! maps (j,i) index to low-tri packed (k) index
|
|
|
|
k = (i-1)*n + j - i*(i-1)/2
|
|
|
|
aux(k) = gam(jl,i) / f(j)
|
|
|
|
END IF
|
|
|
|
j = j + nproc
|
|
|
|
END DO
|
|
|
|
END DO
|
|
|
|
END IF
|
|
|
|
CALL mp_sum(aux, group)
|
|
|
|
ELSE
|
|
|
|
IF( mpime < n ) THEN
|
|
|
|
DO i = 1, n
|
|
|
|
j = mpime + 1
|
|
|
|
DO jl = 1, nrl
|
|
|
|
gam(jl,i) = gam(jl,i) / f(j)
|
|
|
|
j = j + nproc
|
|
|
|
END DO
|
|
|
|
END DO
|
|
|
|
END IF
|
|
|
|
END IF
|
|
|
|
RETURN
|
2005-05-18 16:49:38 +08:00
|
|
|
END SUBROUTINE rpackgam
|
2004-11-25 22:51:47 +08:00
|
|
|
|
2005-03-02 18:03:55 +08:00
|
|
|
! ----------------------------------------------
|
|
|
|
|
2004-11-25 22:51:47 +08:00
|
|
|
! ----------------------------------------------
|
|
|
|
! BEGIN manual
|
|
|
|
|
- FPMD: pseudopotential variable wsg, wnl, fnl substituted with
dion, beta, bec everyware.
- subroutines formfn, compute_beta, nlsm1, nlsm2, ecc ... now are common
between FPMD and CPV, a lot of clean ups!
- Changes in stdout: relevant physical quantities ( positions velocities an cell )
are now printed with the seme format of the corresponding input card,
like in PW, as was suggested by SdG.
- exemple23 updated to reflect the new input namelist "wannier"
- Subroutine init_run now is used in FPMD too.
- WARNING in the stress computed with CP, for a pseudo with core-corrections,
a contribution is missing! Not yet fixed, I need to talk with PG for the
box staff.
- WARNING the examples reference are not updated, I'm on the IBM sp, and
I prefer to update them from a linux machine.
git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@2110 c92efa57-630b-4861-b058-cf58834340f0
2005-08-22 22:14:13 +08:00
|
|
|
SUBROUTINE fermi_energy(eig, occ, wke, ef, qtot, temp, sume)
|
2004-11-25 22:51:47 +08:00
|
|
|
|
|
|
|
! this routine computes Fermi energy and weights of occupied states
|
|
|
|
! using an improved Gaussian-smearing method
|
|
|
|
! refs: C.L.Fu and K.M.Ho, Phys.Rev. B28, 5480 (1983)
|
|
|
|
! M.Methfessel and A.T.Paxton Phys.Rev. B40 (15 aug. 89).
|
|
|
|
!
|
|
|
|
! taken from APW code by J. Soler and A. Williams (jk+ss)
|
|
|
|
! added computation of occupation numbers without k-point weight
|
|
|
|
! ----------------------------------------------
|
|
|
|
! END manual
|
|
|
|
|
- FPMD: pseudopotential variable wsg, wnl, fnl substituted with
dion, beta, bec everyware.
- subroutines formfn, compute_beta, nlsm1, nlsm2, ecc ... now are common
between FPMD and CPV, a lot of clean ups!
- Changes in stdout: relevant physical quantities ( positions velocities an cell )
are now printed with the seme format of the corresponding input card,
like in PW, as was suggested by SdG.
- exemple23 updated to reflect the new input namelist "wannier"
- Subroutine init_run now is used in FPMD too.
- WARNING in the stress computed with CP, for a pseudo with core-corrections,
a contribution is missing! Not yet fixed, I need to talk with PG for the
box staff.
- WARNING the examples reference are not updated, I'm on the IBM sp, and
I prefer to update them from a linux machine.
git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@2110 c92efa57-630b-4861-b058-cf58834340f0
2005-08-22 22:14:13 +08:00
|
|
|
USE brillouin, ONLY: kpoints, kp
|
2004-11-25 22:51:47 +08:00
|
|
|
USE io_global, ONLY: stdout
|
|
|
|
|
|
|
|
IMPLICIT NONE
|
|
|
|
|
|
|
|
! ... declare subroutine arguments
|
2005-08-28 22:09:42 +08:00
|
|
|
REAL(DP) :: occ(:,:,:)
|
|
|
|
REAL(DP) ef, qtot, temp, sume
|
|
|
|
REAL(DP) eig(:,:,:), wke(:,:,:)
|
|
|
|
REAL(DP), PARAMETER :: tol = 1.d-10
|
2004-11-25 22:51:47 +08:00
|
|
|
INTEGER, PARAMETER :: nitmax = 100
|
|
|
|
INTEGER ne, nk, nspin
|
|
|
|
|
|
|
|
! ... declare functions
|
2005-08-28 22:09:42 +08:00
|
|
|
REAL(DP) stepf
|
2004-11-25 22:51:47 +08:00
|
|
|
|
|
|
|
! ... declare other variables
|
2005-08-28 22:09:42 +08:00
|
|
|
REAL(DP) sumq,emin,emax,fac,t,drange
|
2004-11-25 22:51:47 +08:00
|
|
|
INTEGER ik,ispin,ie,iter
|
|
|
|
|
|
|
|
! end of declarations
|
|
|
|
! ----------------------------------------------
|
|
|
|
|
|
|
|
nspin = SIZE( occ, 3)
|
|
|
|
nk = SIZE( occ, 2)
|
|
|
|
ne = SIZE( occ, 1)
|
|
|
|
sumq=0.d0
|
|
|
|
sume=0.d0
|
|
|
|
emin=eig(1,1,1)
|
|
|
|
emax=eig(1,1,1)
|
|
|
|
fac=2.d0
|
|
|
|
IF (nspin.EQ.2) fac=1.d0
|
|
|
|
|
|
|
|
DO ik=1,nk
|
|
|
|
DO ispin=1,nspin
|
|
|
|
DO ie=1,ne
|
|
|
|
wke(ie,ik,ispin) = kp%weight(ik) * fac
|
|
|
|
occ(ie,ik,ispin) = fac
|
|
|
|
sumq=sumq+wke(ie,ik,ispin)
|
|
|
|
sume=sume+wke(ie,ik,ispin)*eig(ie,ik,ispin)
|
|
|
|
emin=MIN(emin,eig(ie,ik,ispin))
|
|
|
|
emax=MAX(emax,eig(ie,ik,ispin))
|
|
|
|
END DO
|
|
|
|
END DO
|
|
|
|
END DO
|
|
|
|
ef=emax
|
|
|
|
IF (abs(sumq-qtot).LT.tol) RETURN
|
|
|
|
IF (sumq.LT.qtot) THEN
|
|
|
|
WRITE( stdout,*) 'FERMIE: NOT ENOUGH STATES'
|
|
|
|
WRITE( stdout,*) 'FERMIE: QTOT,SUMQ=',qtot,sumq
|
|
|
|
STOP
|
|
|
|
END IF
|
|
|
|
t = MAX(temp,1.d-6)
|
|
|
|
drange = t * SQRT( - LOG( tol*.01d0) )
|
|
|
|
emin = emin - drange
|
|
|
|
emax = emax + drange
|
|
|
|
DO iter = 1, nitmax
|
|
|
|
ef = 0.5d0 * (emin+emax)
|
|
|
|
sumq = 0.d0
|
|
|
|
sume = 0.d0
|
|
|
|
DO ik = 1, nk
|
|
|
|
DO ispin = 1, nspin
|
|
|
|
DO ie = 1, ne
|
|
|
|
wke(ie,ik,ispin) = fac / 2.d0 * kp%weight(ik) * stepf((eig(ie,ik,ispin)-ef)/t)
|
|
|
|
occ(ie,ik,ispin) = fac / 2.d0 * stepf((eig(ie,ik,ispin)-ef)/t)
|
|
|
|
sumq = sumq + wke(ie,ik,ispin)
|
|
|
|
sume = sume + wke(ie,ik,ispin) * eig(ie,ik,ispin)
|
|
|
|
END DO
|
|
|
|
END DO
|
|
|
|
END DO
|
|
|
|
IF (ABS(sumq-qtot).LT.tol) RETURN
|
|
|
|
IF (sumq.LE.qtot) emin=ef
|
|
|
|
IF (sumq.GE.qtot) emax=ef
|
|
|
|
END DO
|
|
|
|
|
|
|
|
WRITE( stdout,*) 'FERMIE: ITERATION HAS NOT CONVERGED.'
|
|
|
|
WRITE( stdout,*) 'FERMIE: QTOT,SUMQ=',qtot,sumq
|
|
|
|
STOP
|
|
|
|
|
2005-05-18 16:49:38 +08:00
|
|
|
END SUBROUTINE fermi_energy
|
2004-11-25 22:51:47 +08:00
|
|
|
|
2004-12-21 23:48:19 +08:00
|
|
|
! ----------------------------------------------
|
|
|
|
!
|
|
|
|
!
|
|
|
|
!
|
|
|
|
! ----------------------------------------------
|
|
|
|
|
|
|
|
SUBROUTINE cp_eigs( nfi, bec, c0, irb, eigrb, rhor, rhog, rhos, lambdap, lambda, tau0, h )
|
|
|
|
|
|
|
|
use ensemble_dft, only: tens, ismear, z0, c0diag, becdiag
|
2006-01-10 22:04:13 +08:00
|
|
|
use electrons_base, only: nx => nbspx, n => nbsp, ispin, f, nspin
|
2004-12-21 23:48:19 +08:00
|
|
|
use electrons_base, only: nel, iupdwn, nupdwn, nudx, nelt
|
|
|
|
use energies, only: enl, ekin
|
|
|
|
use uspp, only: rhovan => becsum
|
|
|
|
use grid_dimensions, only: nnr => nnrx
|
|
|
|
use io_global, only: stdout
|
|
|
|
|
|
|
|
IMPLICIT NONE
|
|
|
|
|
|
|
|
INTEGER :: nfi
|
2005-04-15 05:08:53 +08:00
|
|
|
INTEGER :: irb(:,:)
|
2005-08-28 22:09:42 +08:00
|
|
|
COMPLEX(DP) :: c0( :, :, :, : )
|
|
|
|
REAL(DP) :: bec( :, : ), rhor( :, : ), rhos( :, : ), lambda( :, : ), lambdap( :, : )
|
|
|
|
REAL(DP) :: tau0( :, : ), h( 3, 3 )
|
|
|
|
COMPLEX(DP) :: eigrb( :, : ), rhog( :, : )
|
2004-12-21 23:48:19 +08:00
|
|
|
|
2005-08-28 22:09:42 +08:00
|
|
|
real(DP), allocatable:: rhodip(:,:)
|
|
|
|
real(DP) :: dipol( 3 )
|
2004-12-21 23:48:19 +08:00
|
|
|
LOGICAL, SAVE :: lprimo
|
|
|
|
INTEGER :: i
|
|
|
|
|
|
|
|
|
|
|
|
if(.not.tens) then
|
2005-12-21 07:54:54 +08:00
|
|
|
call eigs0(.false.,nspin,nx,nupdwn,iupdwn,.true.,f,lambda)
|
2004-12-21 23:48:19 +08:00
|
|
|
else
|
2005-12-21 07:54:54 +08:00
|
|
|
call eigs0(.false.,nspin,nx,nupdwn,iupdwn,.false.,f,lambdap)
|
2004-12-21 23:48:19 +08:00
|
|
|
endif
|
|
|
|
|
|
|
|
WRITE( stdout,*)
|
|
|
|
|
|
|
|
RETURN
|
2005-05-18 16:49:38 +08:00
|
|
|
END SUBROUTINE cp_eigs
|
2004-11-25 22:51:47 +08:00
|
|
|
|
|
|
|
|
2005-03-02 18:03:55 +08:00
|
|
|
!=----------------------------------------------------------------------------=!
|
|
|
|
END MODULE electrons_module
|
|
|
|
!=----------------------------------------------------------------------------=!
|