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

Cleanup of routines rewading pseudopotentials: 

- upf%tcoulombp is properly set by all routines reading PP in any format.
Previously its value was overridden by a bad initialization (apparently
without consequences: Fourier transforms were computed numerically instead
of analytically as they should, but the difference is not noticeable)
- same for upf%is_gth, which is never read but it is convenient to have it
set while reading
- the dft value is set in a single place, outside the routines reading PP
(removes an illogical dependency)
- additional upf initialization needed in some cases is clearer and better
documented (previousy it was confusing and documentation was misleading)
This commit is contained in:
Paolo Giannozzi 2018-12-29 22:09:38 +01:00
parent bd5a07b991
commit d5082b01f9
8 changed files with 99 additions and 138 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
Modules/make.depend
View File

@ -297,7 +297,6 @@ read_namelists.o : io_global.o
read_namelists.o : kind.o
read_namelists.o : mp_images.o
read_ncpp.o : constants.o
read_ncpp.o : funct.o
read_ncpp.o : kind.o
read_ncpp.o : parameters.o
read_ncpp.o : pseudo_types.o
@ -330,7 +329,6 @@ read_upf_v2.o : parser.o
read_upf_v2.o : pseudo_types.o
read_upf_v2.o : radial_grids.o
read_uspp.o : constants.o
read_uspp.o : funct.o
read_uspp.o : invmat.o
read_uspp.o : io_global.o
read_uspp.o : kind.o
@ -387,7 +385,6 @@ upf.o : read_upf_schema.o
upf.o : read_upf_v1.o
upf.o : read_upf_v2.o
upf.o : wrappers.o
upf_to_internal.o : funct.o
upf_to_internal.o : pseudo_types.o
upf_to_internal.o : radial_grids.o
uspp.o : constants.o

3
Modules/read_ncpp.f90
View File

@ -12,7 +12,6 @@ subroutine read_ncpp (iunps, np, upf)
!
USE kinds, only: dp
USE parameters, ONLY: lmaxx
use funct, only: set_dft_from_name, dft_is_hybrid
USE pseudo_types
implicit none
@ -121,7 +120,6 @@ subroutine read_ncpp (iunps, np, upf)
ELSE
upf%generated='From published tables, or generated by old fitcar code (analytical format)'
END IF
call set_dft_from_name( upf%dft )
!
! calculate the number of beta functions
!
@ -246,6 +244,7 @@ subroutine read_ncpp (iunps, np, upf)
upf%tvanp =.false.
upf%tpawp =.false.
upf%has_so=.false.
upf%tcoulombp=.false.
!
! Set additional, not present, variables to dummy values
allocate(upf%els(upf%nwfc))

30
Modules/read_pseudo.f90
View File

@ -45,12 +45,12 @@ SUBROUTINE readpp ( input_dft, printout, ecutwfc_pp, ecutrho_pp )
USE mp_images, ONLY: intra_image_comm
USE io_global, ONLY: stdout, ionode
USE pseudo_types, ONLY: pseudo_upf, nullify_pseudo_upf, deallocate_pseudo_upf
USE funct, ONLY: enforce_input_dft, &
get_iexch, get_icorr, get_igcx, get_igcc, get_inlc
USE funct, ONLY: enforce_input_dft, set_dft_from_name, &
set_dft_from_indices, get_iexch, get_icorr, get_igcx, get_igcc, get_inlc
use radial_grids, ONLY: deallocate_radial_grid, nullify_radial_grid
USE wrappers, ONLY: md5_from_file
USE upf_module, ONLY: read_upf
USE upf_to_internal, ONLY: set_pseudo_upf
USE upf_to_internal, ONLY: add_upf_grid, set_upf_q
USE read_uspp_module, ONLY: readvan, readrrkj
USE m_gth, ONLY: readgth
!
@ -160,7 +160,6 @@ SUBROUTINE readpp ( input_dft, printout, ecutwfc_pp, ecutrho_pp )
!! start reading - check first if files are readable as xml files,
!! then as UPF v.2, then as UPF v.1
!
upf(nt)%is_gth=.false.
if (isupf == -2 .OR. isupf == -1 .OR. isupf == 0) then
!
IF( printout_) THEN
@ -171,7 +170,9 @@ SUBROUTINE readpp ( input_dft, printout, ecutwfc_pp, ecutrho_pp )
END IF
END IF
!
call set_pseudo_upf (nt, upf(nt))
! reconstruct Q(r) if needed
!
CALL set_upf_q (upf(nt))
!
! UPF is assumed to be multi-projector
!
@ -205,15 +206,12 @@ SUBROUTINE readpp ( input_dft, printout, ecutwfc_pp, ecutrho_pp )
WRITE( stdout, "(3X,'file type is Vanderbilt US PP')")
CALL readvan (iunps, nt, upf(nt))
ENDIF
CALL set_pseudo_upf (nt, upf(nt), rgrid(nt))
!
elseif ( pseudo_type (psfile (nt) ) == 3 ) then
newpseudo (nt) = .true.
!
CALL readgth (iunps, nt, upf(nt))
!
CALL set_pseudo_upf (nt, upf(nt), rgrid(nt))
!
elseif ( pseudo_type (psfile (nt) ) == 4 ) then
newpseudo (nt) = .false.
IF( printout_ ) &
@ -221,14 +219,16 @@ SUBROUTINE readpp ( input_dft, printout, ecutwfc_pp, ecutrho_pp )
!
call read_ncpp (iunps, nt, upf(nt))
!
CALL set_pseudo_upf (nt, upf(nt), rgrid(nt))
!
else
!
CALL errore('readpp', 'file '//TRIM(file_pseudo)//' not readable',1)
!
endif
!
! add grid information, reconstruct Q(r) if needed
!
CALL add_upf_grid (upf(nt), rgrid(nt))
!
! end of reading
!
CLOSE (iunps)
@ -248,6 +248,16 @@ SUBROUTINE readpp ( input_dft, printout, ecutwfc_pp, ecutrho_pp )
!
IF (upf(nt)%tvanp) nvb=nvb+1
!
! ... set DFT value
!
if ( upf(nt)%dft(1:6)=='INDEX:') then
! Workaround for RRKJ format
read( upf(nt)%dft(7:10), '(4i1)') iexch_, icorr_, igcx_, igcc_
call set_dft_from_indices(iexch_, icorr_, igcx_, igcc_, 0)
else
call set_dft_from_name( upf(nt)%dft )
end if
!
! ... Check for DFT consistency - ignored if dft enforced from input
!
IF (nt == 1) THEN

2
Modules/read_upf_schema.f90
View File

@ -59,6 +59,8 @@ SUBROUTINE read_upf_schema(pseudo, upf, grid, ierr ) !
!
! Initialize the file
!
! compatibility
upf%is_gth = .false.
! header and info elements, check version extract main info
header => item ( getElementsByTagname(pseudo, "pp_header" ),0)
info => item ( getElementsByTagname(pseudo, "pp_info" ), 0)

59
Modules/read_upf_v1.f90
View File

@ -14,7 +14,9 @@
! ... declare modules
USE kinds, ONLY: DP
USE radial_grids, ONLY: allocate_radial_grid
USE radial_grids, ONLY: allocate_radial_grid, radial_grid_type
USE pseudo_types, ONLY : pseudo_upf
!
IMPLICIT NONE
SAVE
PRIVATE
@ -22,16 +24,13 @@
CONTAINS
!
!---------------------------------------------------------------------
subroutine read_upf_v1 (iunps, upf, grid, ierr, header_only)
SUBROUTINE read_upf_v1 (iunps, upf, grid, ierr, header_only)
!---------------------------------------------------------------------
!
! read pseudopotential "upf" in the Unified Pseudopotential Format
! from unit "iunps" - return error code in "ierr" (success: ierr=0)
!
use pseudo_types
use radial_grids, only : radial_grid_type
!
implicit none
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: iunps
INTEGER, INTENT(OUT) :: ierr
@ -41,9 +40,9 @@ subroutine read_upf_v1 (iunps, upf, grid, ierr, header_only)
!
! Local variables
!
integer :: ios
character (len=80) :: dummy
logical, external :: matches
INTEGER :: ios
CHARACTER (len=80) :: dummy
LOGICAL, EXTERNAL :: matches
!
! Prepare the pointers
! CALL nullify_pseudo_upf( upf ) should be nullified when instantiated
@ -211,9 +210,6 @@ end subroutine scan_end
subroutine read_pseudo_header (upf, iunps)
!---------------------------------------------------------------------
!
USE pseudo_types, ONLY: pseudo_upf
USE kinds
implicit none
!
TYPE (pseudo_upf), INTENT(INOUT) :: upf
@ -222,7 +218,8 @@ subroutine read_pseudo_header (upf, iunps)
integer :: nw
character (len=80) :: dummy
logical, external :: matches
! GTH analytical format: obviously not true in this case
upf%is_gth=.false.
! Version number (presently ignored)
read (iunps, *, err = 100, end = 100) upf%nv , dummy
! Element label
@ -283,9 +280,6 @@ end subroutine read_pseudo_header
subroutine read_pseudo_mesh (upf, iunps)
!---------------------------------------------------------------------
!
USE kinds
USE pseudo_types, ONLY: pseudo_upf
implicit none
!
integer :: iunps
@ -322,9 +316,6 @@ end subroutine read_pseudo_mesh
subroutine read_pseudo_nlcc (upf, iunps)
!---------------------------------------------------------------------
!
USE kinds
USE pseudo_types, ONLY: pseudo_upf
implicit none
!
integer :: iunps
@ -347,9 +338,6 @@ end subroutine read_pseudo_nlcc
subroutine read_pseudo_local (upf, iunps)
!---------------------------------------------------------------------
!
USE kinds
USE pseudo_types, ONLY: pseudo_upf
implicit none
!
integer :: iunps
@ -373,9 +361,6 @@ end subroutine read_pseudo_local
subroutine read_pseudo_nl (upf, iunps)
!---------------------------------------------------------------------
!
USE kinds
USE pseudo_types, ONLY: pseudo_upf
implicit none
!
integer :: iunps
@ -537,9 +522,6 @@ end subroutine read_pseudo_nl
subroutine read_pseudo_pswfc (upf, iunps)
!---------------------------------------------------------------------
!
USE kinds
USE pseudo_types, ONLY: pseudo_upf
!
implicit none
!
integer :: iunps
@ -564,9 +546,6 @@ end subroutine read_pseudo_pswfc
subroutine read_pseudo_rhoatom (upf, iunps)
!---------------------------------------------------------------------
!
USE kinds
USE pseudo_types, ONLY: pseudo_upf
!
implicit none
!
integer :: iunps
@ -591,8 +570,6 @@ subroutine read_pseudo_addinfo (upf, iunps)
! and the total angular momentum jjj of the beta and jchi of the
! wave-functions.
!
USE pseudo_types, ONLY: pseudo_upf
USE kinds
implicit none
integer :: iunps
@ -642,9 +619,6 @@ end subroutine read_pseudo_addinfo
SUBROUTINE read_pseudo_gipaw ( upf, iunps )
!---------------------------------------------------------------------
!
USE kinds
USE pseudo_types, ONLY : pseudo_upf
!
implicit none
!
INTEGER :: iunps
@ -673,9 +647,6 @@ END SUBROUTINE read_pseudo_gipaw
SUBROUTINE read_pseudo_gipaw_core_orbitals ( upf, iunps )
!---------------------------------------------------------------------
!
USE kinds
USE pseudo_types, ONLY : pseudo_upf
!
IMPLICIT NONE
!
INTEGER :: iunps
@ -714,9 +685,6 @@ END SUBROUTINE read_pseudo_gipaw_core_orbitals
SUBROUTINE read_pseudo_gipaw_local ( upf, iunps )
!---------------------------------------------------------------------
!
USE kinds
USE pseudo_types, ONLY : pseudo_upf
!
IMPLICIT NONE
!
INTEGER :: iunps
@ -754,9 +722,6 @@ END SUBROUTINE read_pseudo_gipaw_local
SUBROUTINE read_pseudo_gipaw_orbitals ( upf, iunps )
!---------------------------------------------------------------------
!
USE kinds
USE pseudo_types, ONLY : pseudo_upf
!
IMPLICIT NONE
!
INTEGER :: iunps
@ -803,9 +768,6 @@ END SUBROUTINE read_pseudo_gipaw_orbitals
subroutine read_pseudo_ppinfo (upf, iunps)
!---------------------------------------------------------------------
!
USE pseudo_types, ONLY: pseudo_upf
USE kinds, ONLY : dp
implicit none
!
TYPE (pseudo_upf), INTENT(INOUT) :: upf
@ -831,7 +793,6 @@ subroutine read_pseudo_ppinfo (upf, iunps)
END SUBROUTINE read_pseudo_ppinfo
SUBROUTINE set_coulomb_nonlocal(upf)
USE pseudo_types, ONLY : pseudo_upf
IMPLICIT NONE
TYPE(pseudo_upf) :: upf

5
Modules/read_upf_v2.f90
View File

@ -149,7 +149,7 @@ CONTAINS
CALL destroy(u)
!
IF( present(ierr) ) ierr=0
!
RETURN
END SUBROUTINE read_upf_v2
@ -171,6 +171,9 @@ SUBROUTINE read_upf_header(u, upf)
CHARACTER(LEN=256) :: attr
TYPE(DOMException) :: ex
!
! GTH analytical format: obviously not true in this case
upf%is_gth=.false.
!
! Read HEADER section with some initialization data
hdrNode => item( getElementsByTagname(u, 'PP_HEADER'), 0 )
IF ( hasAttribute( hdrNode, 'generated') ) THEN

8
Modules/read_uspp.f90
View File

@ -15,8 +15,6 @@ MODULE read_uspp_module
USE kinds, ONLY: DP
USE parameters, ONLY: lmaxx, lqmax
USE io_global, ONLY: stdout
USE funct, ONLY: set_dft_from_name, dft_is_hybrid, dft_is_meta, &
set_dft_from_indices
USE matrix_inversion
!
! Variables above are not modified, variables below are
@ -163,9 +161,6 @@ CONTAINS
& call errore('readvan','Wrong xc in pseudopotential',1)
! convert from "our" conventions to Vanderbilt conventions
call dftname_cp (nint(exfact), upf%dft)
call set_dft_from_name( upf%dft )
IF ( dft_is_meta() ) &
CALL errore( 'readvan ', 'META-GGA not implemented', 1 )
!
read( iunps, '(2i5,1pe19.11)', err=100, iostat=ios ) &
upf%nwfc, upf%mesh, etotpseu
@ -199,7 +194,9 @@ CONTAINS
call errore('readvan','keyps not implemented',keyps)
end if
upf%tvanp = (keyps == 3)
! for compatibility
upf%tpawp = .false.
upf%tcoulombp = .false.
!
! Read information on the angular momenta, and on Q pseudization
! (version > 3.0)
@ -675,7 +672,6 @@ CONTAINS
! See also upf2internals
!
write( upf%dft, "('INDEX:',4i1)") iexch,icorr,igcx,igcc
call set_dft_from_indices(iexch,icorr,igcx,igcc, 0) ! Cannot read nonlocal in this format
read( iunps, '(2e17.11,i5)') &
upf%zp, etotps, lmax

111
Modules/upf_to_internal.f90
View File

@ -12,9 +12,10 @@
MODULE upf_to_internal
!=----------------------------------------------------------------------------=!
USE pseudo_types
IMPLICIT NONE
PRIVATE
PUBLIC :: set_pseudo_upf
PUBLIC :: add_upf_grid, set_upf_q
SAVE
!=----------------------------------------------------------------------------=!
@ -22,45 +23,21 @@
!=----------------------------------------------------------------------------=!
!
!---------------------------------------------------------------------
subroutine set_pseudo_upf (is, upf, grid)
SUBROUTINE add_upf_grid (upf, grid)
!---------------------------------------------------------------------
!
! set "is"-th pseudopotential using the Unified Pseudopotential Format
! "upf" - convert and copy to internal variables
! If "grid" is present, reconstruct radial grid.
! Obsolescent - for old-style PP formats only.
! Complete pseudopotential "upf" read from old-style PP files
! by reconstructing the radial grid and the Q(r) functions
! Obsolescent, to be used with old formats only
!
USE funct, ONLY: set_dft_from_name, set_dft_from_indices
!
USE pseudo_types
USE radial_grids, ONLY: radial_grid_type, allocate_radial_grid
!
implicit none
IMPLICIT NONE
!
INTEGER :: is
TYPE (pseudo_upf) :: upf
TYPE (radial_grid_type), target, optional :: grid
TYPE (radial_grid_type), target :: grid
!
! Local variables
!
integer :: iexch,icorr,igcx,igcc
INTEGER :: nb, mb, ijv, ir, ilast, l, l1, l2
!
! old formats never contain "1/r" pseudopotentials
!
upf%tcoulombp = .false.
!
! workaround for rrkj format - it contains the indices, not the name
!
if ( upf%dft(1:6)=='INDEX:') then
read( upf%dft(7:10), '(4i1)') iexch,icorr,igcx,igcc
call set_dft_from_indices(iexch,icorr,igcx,igcc, 0) !Cannot read nonloc in this format
else
call set_dft_from_name( upf%dft )
end if
!
if(present(grid)) then
call allocate_radial_grid(grid,upf%mesh)
CALL allocate_radial_grid(grid,upf%mesh)
grid%dx = upf%dx
grid%xmin = upf%xmin
grid%zmesh= upf%zmesh
@ -69,48 +46,64 @@ subroutine set_pseudo_upf (is, upf, grid)
grid%r (1:upf%mesh) = upf%r (1:upf%mesh)
grid%rab(1:upf%mesh) = upf%rab(1:upf%mesh)
upf%grid => grid
endif
!
! For USPP we set the augmentation charge as an l-dependent array in all cases.
! This is already the case when upf%tpawp or upf%q_with_l are .true. .
! For vanderbilt US pseudos, where nqf and rinner are non zero, we do here what otherwise
! would be done multiple times in many parts of the code (such as in init_us_1, addusforce_r,
! bp_calc_btq, compute_qdipol) whenever the q_l(r) were to be constructed.
! For simple rrkj3 pseudos we duplicate the infomation contained in q(r) for all q_l(r).
CALL set_upf_q (upf)
!
! This requires a little extra memory but unifies the treatment of q_l(r) and allows further
! tweaking with the augmentation charge.
END SUBROUTINE add_upf_grid
!
!---------------------------------------------------------------------
SUBROUTINE set_upf_q (upf)
!---------------------------------------------------------------------
!
if ( upf%tvanp .and. .not.upf%q_with_l ) then
! For USPP we set the augmentation charge as an l-dependent array in all
! cases. This is already the case when upf%tpawp or upf%q_with_l are .true.
! For vanderbilt US pseudos, where nqf and rinner are non zero, we do here
! what otherwise would be done multiple times in many parts of the code
! (such as in init_us_1, addusforce_r, bp_calc_btq, compute_qdipol)
! whenever the q_l(r) were to be constructed.
! For simple rrkj3 pseudos we duplicate the infomration contained in q(r)
! for all q_l(r).
!
! This requires a little extra memory but unifies the treatment of q_l(r)
! and allows further weaking with the augmentation charge.
!
IMPLICIT NONE
!
TYPE (pseudo_upf) :: upf
!
! Local variables
!
INTEGER :: nb, mb, ijv, ir, ilast, l, l1, l2
!
IF ( upf%tvanp .and. .not.upf%q_with_l ) THEN
ALLOCATE( upf%qfuncl ( upf%mesh, upf%nbeta*(upf%nbeta+1)/2, 0:upf%nqlc-1 ) )
upf%qfuncl = 0.0_DP
do nb = 1, upf%nbeta
do mb = nb, upf%nbeta
DO nb = 1, upf%nbeta
DO mb = nb, upf%nbeta
! ijv is the combined (nb,mb) index
ijv = mb * (mb-1) / 2 + nb
l1=upf%lll(nb) ; l2=upf%lll(mb)
! copy q(r) to the l-dependent grid
! copy q(r) to the l-dependent grid
DO l=abs(l1-l2),l1+l2,2
upf%qfuncl(1:upf%mesh,ijv,l) = upf%qfunc(1:upf%mesh,ijv)
END DO
! adjust the inner values on the l-dependent grid if nqf and rinner are defined
if ( upf%nqf > 0 ) then
do l = abs(l1-l2),l1+l2, 2
if ( upf%rinner (l+1) > 0.0_dp) then
do ir = 1, upf%kkbeta
IF ( upf%nqf > 0 ) THEN
DO l = abs(l1-l2),l1+l2, 2
IF ( upf%rinner (l+1) > 0.0_dp) THEN
DO ir = 1, upf%kkbeta
if (upf%r(ir) <upf%rinner (l+1) ) ilast = ir
enddo
call setqfnew( upf%nqf,upf%qfcoef(1,l+1,nb,mb), ilast, upf%r, l, 2, upf%qfuncl(1,ijv,l) )
end if
end do
end if
enddo
enddo
end if
end subroutine set_pseudo_upf
END DO
CALL setqfnew( upf%nqf,upf%qfcoef(1,l+1,nb,mb), ilast, upf%r, l, 2, upf%qfuncl(1,ijv,l) )
END IF
END DO
END IF
END DO
END DO
END IF
END SUBROUTINE set_upf_q
!=----------------------------------------------------------------------------=!
END MODULE upf_to_internal
!=----------------------------------------------------------------------------=!