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

416 lines
13 KiB
Fortran
Raw Permalink Blame History

!
! Copyright (C) 2023 Quantum ESPRESSO Foundation
! 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 .
!
!---------------------------------------------------------------------
MODULE read_psml_module
!---------------------------------------------------------------------
!
PUBLIC :: read_psml
!
CONTAINS
!--------------------------------------------------------
subroutine read_psml ( filename, upf, ierr )
!-----------------------------------------------------
!! Read pseudopotential files in PSML format using "xmltools"
!! stores data into the "upf" structure. Note that:
!! - PSML uses a nonstandard radial grid that is not well suited
!! for QE integration methods, so all variables are interpolated
!! to a uniform grid (grid parameters: dr=0.01, rmax=5 a.u.,
!! the latter being the typical rmax used in PSML)
!! - in PSML, most arrays: local potential, projectors, charges,
!! may be shorter than the full length of the radial grid
!! (as specified in tag argument "npts"), while in the UPF
!! format and upf% structure they all have the same upf%mesh size
!! To get QE variables from PSML ones:
!! - PSML pseudo-core charge must be divided by 4\pi (why? don't know)
!! - PSML projectors must be multiplied by r (why? don't know)
!! - PSML potentials must be multiplied by e^2=2 to bring them to Ry
!! Tested only for a small subset of PSML files
!! Written by P. Giannozzi, April 2023
!
USE xmltools
USE upf_kinds, ONLY : dp
USE upf_const, ONLY : e2, fpi
USE pseudo_types, ONLY: pseudo_upf
!
IMPLICIT NONE
!
CHARACTER(len=*), INTENT(IN) :: filename
!! input : name of file in psml format
TYPE(pseudo_upf), INTENT(INOUT) :: upf
!! the derived type storing the pseudo data
!! INOUT because many variables are reset to default values in input
INTEGER, INTENT(OUT) :: ierr
!! error code (0 if correctly read)
CHARACTER(len=30) :: tag
!! tag where error (ierr != 0) was detected
INTEGER :: iun
!! unit for reading data
!
ierr = 0
iun = xml_open_file ( filename )
IF ( iun == -1 ) THEN
ierr = 1
tag = 'file'
GO TO 10
END IF
!
tag = 'psml'
call xmlr_opentag ( trim(tag), IERR = ierr )
IF ( ierr /= 0 ) GO TO 10
call get_attr ( 'version', upf%nv )
! print *, 'version=',upf%nv
call get_attr ( 'uuid', upf%author )
!
tag = 'provenance'
call xmlr_opentag ( trim(tag), IERR = ierr )
IF ( ierr /= 0 ) GO TO 10
call get_attr ( 'creator', upf%generated )
upf%author='UUID: '//trim(upf%author)
call get_attr ( 'date', upf%date )
upf%comment='PSML file v. '//trim(upf%nv)
call xmlr_closetag ( ) ! provenance'
!
tag = 'pseudo-atom-spec'
call read_psml_pseudo_atom_spec ( tag, ierr )
IF ( ierr /= 0 ) GO TO 10
!
tag = 'grid'
call read_psml_grid ( ierr )
IF ( ierr /= 0 ) GO TO 10
!
tag = 'valence-charge'
call read_psml_radialfunc ( tag, upf%rho_at, ierr )
IF ( ierr /= 0 ) GO TO 10
!
IF ( upf%nlcc ) THEN
tag = 'pseudocore-charge'
call read_psml_radialfunc ( tag, upf%rho_atc, ierr )
IF ( ierr /= 0 ) GO TO 10
upf%rho_atc(:) = upf%rho_atc(:) / fpi
END IF
!
tag = 'local-potential'
call read_psml_radialfunc ( tag, upf%vloc, ierr )
IF ( ierr /= 0 ) GO TO 10
!
tag = 'nonlocal-projectors'
call read_psml_nonlocal_projectors ( ierr )
IF ( ierr /= 0 ) GO TO 10
!
tag = 'pseudo-wave-functions'
call read_psml_pseudo_wave_functions ( ierr )
IF ( ierr /= 0 ) THEN
!! optional tag, may or may not be present
print *, 'read_psml: tag ',trim(tag),' not present'
upf%nwfc = 0
ierr = 0
END IF
!
call xmlr_closetag ( ) ! psml
call xml_closefile( )
!
! upf%r now contains the original grid, upf%rab the uniform grid
! all arrays are read in the former and interpolated on the latter
! now set the correct grid and grid derivative (upf%rab = (dr/dx)*dx)
!
deallocate(upf%r)
allocate(upf%r(upf%mesh))
upf%r = upf%rab
upf%rab = upf%dx
!
! Convert from Hartree (PSML) to Ry
!
upf%vloc(:) = e2*upf%vloc(:)
upf%dion(:,:) = e2*upf%dion(:,:)
!
RETURN
10 print *, 'read_psml: error reading tag ',trim(tag)
stop
!
CONTAINS
!
SUBROUTINE read_psml_pseudo_atom_spec ( tag, ierr )
!
CHARACTER(len=*), INTENT(inout) :: tag
INTEGER, INTENT(out) :: ierr
INTEGER :: n, nxc, ndum
INTEGER :: xc(6)
CHARACTER(len=3) :: cc
!
upf%tvanp = .false.
upf%tpawp = .false.
upf%has_so = .false.
upf%has_gipaw = .false.
upf%paw_as_gipaw = .false.
upf%tcoulombp = .false.
upf%is_gth = .false.
upf%is_multiproj = .false.
upf%typ = 'NC'
call xmlr_opentag ( 'pseudo-atom-spec', IERR = ierr )
if (ierr /= 0) return
call get_attr ( 'atomic-label', upf%psd )
call get_attr ( 'atomic-number', upf%zmesh )
call get_attr ( 'relativity', upf%rel )
if ( upf%rel(1:5) == 'dirac' ) then
upf%rel='full'
upf%has_so = .true.
end if
call get_attr ( 'core-corrections', cc )
upf%nlcc = (cc == 'yes')
tag = 'exchange-correlation'
call xmlr_opentag ( tag, IERR = ierr )
if (ierr /= 0) return
tag = 'libxc-info'
call xmlr_opentag ( tag, IERR = ierr )
if (ierr /= 0) return
call get_attr ( 'number-of-functionals', nxc )
do n=1,nxc
tag = 'functional'
call xmlr_readtag ( tag, xc(n), IERR = ierr )
if (ierr > 0) return
call get_attr ( 'id', xc(n) )
end do
call xmlr_closetag ( ) ! libxc-info
call xmlr_closetag ( ) ! exchange-correlation
!
upf%dft = libxc_to_qe (nxc, xc)
!
tag = 'valence-configuration'
call xmlr_opentag ( tag, IERR = ierr )
if (ierr /= 0) return
tag = 'total-valence-charge'
call get_attr ( tag, upf%zp )
! here just count the number of valence wavefunctions
n=0
do
tag = 'shell'
call xmlr_readtag ( tag, cc, IERR = ierr )
if (ierr /= -1) exit
n = n+1
!call get_attr ( 'n', ndum )
!call get_attr ( 'l', cc )
!call get_attr ( 'occupation', ndum )
end do
upf%nwfc = n
call xmlr_closetag ( ) ! valence-configuration
call xmlr_closetag ( ) ! pseudo-atom-spec
!
ierr = 0
!
END SUBROUTINE read_psml_pseudo_atom_spec
!
SUBROUTINE read_psml_grid ( ierr )
!
INTEGER, INTENT(OUT) :: ierr
INTEGER :: npt, n
REAL(dp):: step, r0, delta
CHARACTER(LEN=1) :: dum
!
call xmlr_opentag ( 'grid', IERR = ierr )
if (ierr /= 0) return
call get_attr ( 'npts', npt )
allocate (upf%r(npt))
call xmlr_readtag ( 'annotation', dum, IERR = ierr )
if (ierr > 0) return
call get_attr ( 'step', step )
call get_attr ( 'scale', r0 )
call get_attr ( 'delta', delta )
call xmlr_readtag ( 'grid-data', upf%r, IERR = ierr )
if (ierr /= 0) return
call xmlr_closetag ( ) ! grid
! Now store in upf%rab a uniform grid with dx=0.01 up to rmax=5
upf%dx = 0.01_dp
upf%rmax=5.0_dp
upf%mesh = upf%rmax/upf%dx+1
allocate (upf%rab(upf%mesh))
do n = 1, upf%mesh
upf%rab(n) = (n-1)*upf%dx
end do
!
END SUBROUTINE read_psml_grid
!
SUBROUTINE read_psml_radialfunc ( tag, rho, ierr )
!
USE splinelib, ONLY : dosplineint
CHARACTER(len=*) :: tag
REAL(dp), allocatable :: rho(:)
REAL(DP), allocatable :: rint(:)
INTEGER :: ierr
INTEGER :: npt
!
call xmlr_opentag ( trim(tag), IERR = ierr )
if (ierr /= 0) return
call xmlr_opentag ( 'radfunc', IERR = ierr )
if (ierr /= 0) return
call xmlr_opentag ( 'data', IERR = ierr )
if (ierr /= 0) return
call get_attr ( 'npts', npt )
! may differ
if ( npt > size(upf%r) ) then
ierr = 1
return
end if
allocate ( rint(npt) )
allocate ( rho (upf%mesh) )
read (iun,*) rint
call dosplineint( upf%r(1:npt), rint, upf%rab, rho )
call xmlr_closetag ( ) ! data
call xmlr_closetag ( ) ! radfunc
call xmlr_closetag ( ) ! tag
deallocate (rint)
!
END SUBROUTINE read_psml_radialfunc
!
SUBROUTINE read_psml_nonlocal_projectors ( ierr )
!
USE splinelib, ONLY : dosplineint
USE upf_utils, only: spdf_to_l
INTEGER :: ierr
INTEGER :: n, nb, npt, ndum
REAL(DP), allocatable :: betaint(:)
REAL(dp) :: ekb, j
CHARACTER(len=1) :: spdf
!
call xmlr_opentag('nonlocal-projectors', IERR = ierr )
if (ierr /= 0) return
upf%nbeta = 0
upf%kkbeta= 0
nb=0
do
call xmlr_opentag ( 'proj', IERR = ierr )
call get_attr ( 'l', spdf )
call get_attr ( 'j', j )
! call get_attr ( 'seq',ndum )
call get_attr ( 'ekb',ekb )
call xmlr_opentag ( 'radfunc' )
if ( ierr == -10 .and. upf%nbeta == 0 ) then
! first scan of the file completed, file has been rewound:
! set number of projectors, allocate and read arrays
upf%nbeta = nb
ALLOCATE (upf%els_beta(nb), &
upf%lll(nb), &
upf%kbeta(nb), &
upf%rcut(nb), &
upf%rcutus(nb), &
upf%dion(nb,nb), &
upf%qqq(nb,nb) )
allocate (upf%beta(upf%mesh,nb))
IF (upf%has_so) ALLOCATE( upf%jjj(nb) )
upf%rcut(:) = 0.0_dp
upf%rcutus(:)= 0.0_dp
upf%dion(:,:)= 0.0_dp
upf%qqq(:,:) = 0.0_dp
! reset counter
nb = 0
end if
nb = nb+1
call xmlr_opentag ( 'data', IERR = ierr )
call get_attr ( 'npts', npt )
if ( upf%nbeta > 0 ) then
allocate (betaint(npt))
! actual read is done here during the second scan
read (iun,*) betaint
call dosplineint( upf%r(1:npt), betaint, upf%rab, upf%beta(:,nb))
do n=1,upf%mesh
upf%beta(n,nb) = upf%beta(n,nb) * upf%rab(n)
end do
upf%dion(nb,nb) = ekb
upf%els_beta(nb) = '*'//spdf
upf%lll(nb) = spdf_to_l(spdf)
if (upf%has_so) upf%jjj(nb) = j
upf%kbeta(nb) = npt
deallocate (betaint)
else
! set max length of projectors during the first scan
upf%kkbeta = max ( upf%kkbeta, npt )
end if
call xmlr_closetag () ! data
call xmlr_closetag () ! radfun
call xmlr_closetag () ! proj
if ( nb == upf%nbeta ) exit
end do
call xmlr_closetag ( ) ! nonlocal-projectors
!
END SUBROUTINE read_psml_nonlocal_projectors
!
SUBROUTINE read_psml_pseudo_wave_functions ( ierr )
!
USE upf_utils, only : spdf_to_l
USE splinelib, ONLY : dosplineint
INTEGER :: ierr
INTEGER :: n, npt, ndum
REAL(dp), ALLOCATABLE :: chint(:)
CHARACTER(len=1) :: spdf
!
call xmlr_opentag('pseudo-wave-functions', IERR = ierr )
if (ierr /= 0) return
allocate ( upf%chi(upf%mesh,upf%nwfc) )
allocate ( upf%els(upf%nwfc), &
upf%oc(upf%nwfc), &
upf%lchi(upf%nwfc), &
upf%nchi(upf%nwfc), &
upf%rcut_chi(upf%nwfc), &
upf%rcutus_chi(upf%nwfc), &
upf%epseu(upf%nwfc) )
upf%rcut_chi(:) = 0.0_dp
upf%rcutus_chi(:)= 0.0_dp
upf%oc(upf%nwfc) = 0.0_dp
IF ( upf%has_so ) allocate ( upf%jchi(upf%nwfc) )
do n=1,upf%nwfc
call xmlr_opentag ( 'pswf', IERR = ierr )
if ( ierr /= 0 ) return
call get_attr ( 'l', spdf )
call get_attr ( 'n', upf%nchi(n) )
if ( upf%has_so ) call get_attr ( 'j', upf%jchi(n) )
call get_attr ( 'energy_level', upf%epseu(n) )
upf%lchi(n) = spdf_to_l(spdf)
write(upf%els(n),'(i1,a1)') upf%nchi(n), spdf
call xmlr_opentag ( 'radfunc' )
call xmlr_opentag ( 'data', IERR = ierr )
call get_attr ( 'npts', npt )
if ( npt > size(upf%r) ) then
ierr = 1
return
end if
allocate ( chint(npt) )
read (iun,*) chint
call dosplineint( upf%r(1:npt), chint, upf%rab, upf%chi(:,n))
deallocate ( chint)
call xmlr_closetag () ! data
call xmlr_closetag () ! radfun
call xmlr_closetag () ! pswf
end do
call xmlr_closetag ( ) ! pseudo-wave-functions
!
END SUBROUTINE read_psml_pseudo_wave_functions
!
END subroutine read_psml
function libxc_to_qe (nxc, xc)
integer :: nxc
integer :: xc(nxc)
character(len=25) :: libxc_to_qe
!
libxc_to_qe = 'Not Recognized'
! print *, 'nxc, nc = ', nxc,xc
if ( nxc < 2 ) return
if ( xc(1) == 1 .and. xc(2) == 9 ) then
libxc_to_qe = 'SLA-PZ' ! Perdew-Zunger
else if ( xc(1) == 1 .and. xc(2) == 12 ) then
libxc_to_qe = 'SLA-PW' ! Perdew-Wang
else if ( xc(1) == 101 .and. xc(2) == 130 ) then
libxc_to_qe = 'SLA-PW-PBX-PBC' ! PBE
else if ( xc(1) == 116 .and. xc(2) == 133 ) then
libxc_to_qe = 'SLA-PW-PSX-PSC' ! PBESOL
end if
!
end function libxc_to_qe
END MODULE read_psml_module
Reference in New Issue View Git Blame Copy Permalink