mirror of https://gitlab.com/QEF/q-e.git
1005 lines
40 KiB
Fortran
1005 lines
40 KiB
Fortran
!
|
|
! Copyright (C) 2008-2011 Quantum ESPRESSO group
|
|
! 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_upf_v2_module
|
|
!-----------------------------------------------------------------------------=!
|
|
!! this module provides the function read_upf_v2 to read pseudopotential data
|
|
!! from files in UPF format version 2.
|
|
|
|
! ... declare modules
|
|
USE kinds, ONLY: DP
|
|
USE pseudo_types, ONLY: pseudo_upf
|
|
USE radial_grids, ONLY: radial_grid_type
|
|
USE parser, ONLY : version_compare
|
|
USE FoX_DOM
|
|
!
|
|
PRIVATE
|
|
PUBLIC :: read_upf_v2
|
|
CONTAINS
|
|
!------------------------------------------------+
|
|
SUBROUTINE read_upf_v2(u, upf, grid, ierr) !
|
|
!---------------------------------------------+
|
|
!! Read pseudopotential in UPF format version 2, uses fox libraries.
|
|
!! data are stored in a pseudo_upf structure ( upf argument ),
|
|
!! optionally mesh data may be stored in a radial_grid_type strucure
|
|
!! ( grid argument).
|
|
!! If ierr argument is present the error status is returned otherwise
|
|
!! in case of error the program stops.
|
|
!! @Note version 2 UPF files generated with older versions of QE may contain
|
|
!! whithin in the PP_INFO/PP_INPUT section some xml reserved characters which
|
|
!! prevent any standard xml reader to parse them. To make the UPF file accessible is
|
|
!! sufficient to bracket all the text data within the PP_INPUT section with <![CDATA[
|
|
!! and ]]>
|
|
|
|
USE pseudo_types, ONLY: nullify_pseudo_upf, deallocate_pseudo_upf
|
|
USE radial_grids, ONLY: radial_grid_type, nullify_radial_grid
|
|
IMPLICIT NONE
|
|
TYPE(Node),POINTER,INTENT(IN) :: u
|
|
!! pointer to root DOM node.
|
|
TYPE(pseudo_upf),INTENT(INOUT) :: upf
|
|
!! pseudo_upf type structure storing the pseudo data
|
|
TYPE(radial_grid_type),OPTIONAL,INTENT(INOUT),TARGET :: grid
|
|
!! optional structure where to store mesh data
|
|
INTEGER,OPTIONAL,INTENT(OUT):: ierr
|
|
!! /= 0 if something went wrong
|
|
!
|
|
!
|
|
INTEGER :: ierr_
|
|
TYPE(DOMException) :: ex
|
|
TYPE(Node), POINTER :: auxNode
|
|
LOGICAL :: found
|
|
LOGICAL,EXTERNAL :: matches
|
|
CHARACTER(len = 256) :: root
|
|
CHARACTER(len=6),PARAMETER :: max_version = '2.0.1'
|
|
!
|
|
! Prepare the type . Should be done where upf is instantiated
|
|
! CALL deallocate_pseudo_upf(upf)
|
|
! CALL nullify_pseudo_upf(upf)
|
|
!
|
|
! IF(present(grid)) call nullify_radial_grid(grid)
|
|
! nullify(upf%grid)
|
|
!
|
|
! Initialize the file
|
|
root = getTagname(u, EX = ex)
|
|
ierr_ = getExceptionCode(ex)
|
|
!
|
|
IF((abs(ierr_)>0) ) THEN
|
|
!
|
|
IF(.not. present(ierr)) &
|
|
CALL errore('read_upf_v2','Cannot open UPF file.',1)
|
|
ierr = 1
|
|
RETURN
|
|
ENDIF
|
|
IF ( .not. matches('UPF',root) ) THEN
|
|
IF (PRESENT (ierr) ) THEN
|
|
CALL infomsg( 'read_upf_v2', 'tagname is '//TRIM(root)//' instead of UPF' )
|
|
ierr = 2
|
|
RETURN
|
|
ELSE
|
|
CALL errore('read_upf_v2', 'tagname is '//TRIM(root)//' instead of UPF',2)
|
|
END IF
|
|
END IF
|
|
CALL extractDataAttribute(u, 'version', upf%nv)
|
|
IF (version_compare(upf%nv, max_version) == 'newer') &
|
|
CALL errore('read_upf_v2', 'Unknown UPF format version: '//TRIM(upf%nv),1)
|
|
!
|
|
!
|
|
! Read machine-readable header
|
|
!
|
|
CALL read_upf_header(u, upf)
|
|
IF(upf%tpawp .and. .not. present(grid)) &
|
|
CALL errore('read_upf_v2', 'PAW requires a radial_grid_type.', 1)
|
|
!
|
|
! CHECK for bug in version 2.0.0 of UPF file
|
|
IF ( version_compare(upf%nv, '2.0.1') == 'older' .and. upf%tvanp .and. &
|
|
.not. upf%tpawp ) CALL errore('read_upf_v2',&
|
|
'Ultrasoft pseudopotentials in UPF format v.2.0.0 are &
|
|
& affected by a bug compromising their quality. Please &
|
|
& regenerate pseudopotential file for '//TRIM(upf%psd), 1)
|
|
|
|
! Read radial grid mesh
|
|
CALL read_upf_mesh(u, upf, grid)
|
|
! Read non-linear core correction charge
|
|
ALLOCATE( upf%rho_atc(upf%mesh) )
|
|
IF(upf%nlcc) THEN
|
|
auxNode => item(getElementsByTagname(u, 'PP_NLCC'), 0)
|
|
CALL extractDataContent(auxNode, upf%rho_atc)
|
|
ELSE
|
|
! A null core charge simplifies several functions, mostly in PAW
|
|
upf%rho_atc(1:upf%mesh) = 0._dp
|
|
ENDIF
|
|
! Read local potential
|
|
IF(.not. upf%tcoulombp) THEN
|
|
ALLOCATE( upf%vloc(upf%mesh) )
|
|
auxNode => item( getElementsByTagname( u, 'PP_LOCAL'), 0)
|
|
CALL extractDataContent(auxNode, upf%vloc)
|
|
ENDIF
|
|
! Read nonlocal components: projectors, augmentation, hamiltonian elements
|
|
|
|
CALL read_upf_nonlocal(u, upf)
|
|
|
|
! Read initial pseudo wavefunctions
|
|
! (usually only wfcs with occupancy > 0)
|
|
CALL read_upf_pswfc(u, upf)
|
|
|
|
! Read all-electron and pseudo wavefunctions
|
|
CALL read_upf_full_wfc(u, upf)
|
|
|
|
! Read valence atomic density (used for initial density)
|
|
ALLOCATE( upf%rho_at(upf%mesh) )
|
|
auxNode => item(getElementsByTagname(u, 'PP_RHOATOM'), 0)
|
|
CALL extractDataContent(auxNode, upf%rho_at)
|
|
|
|
! Read additional info for full-relativistic calculation
|
|
CALL read_upf_spin_orb(u, upf)
|
|
|
|
! Read additional data for PAW (All-electron charge, wavefunctions, vloc..)
|
|
CALL read_upf_paw(u, upf)
|
|
|
|
! Read data for gipaw reconstruction
|
|
CALL read_upf_gipaw(u, upf)
|
|
|
|
!
|
|
! Close the file (not the unit!)
|
|
CALL destroy(u)
|
|
!
|
|
IF( present(ierr) ) ierr=0
|
|
|
|
RETURN
|
|
|
|
END SUBROUTINE read_upf_v2
|
|
!
|
|
SUBROUTINE read_upf_header(u, upf)
|
|
IMPLICIT NONE
|
|
TYPE(Node),POINTER,INTENT(IN) :: u ! parent node pointer
|
|
TYPE(pseudo_upf),INTENT(INOUT) :: upf ! the pseudo data
|
|
INTEGER :: ierr, ios ! /= 0 if something went wrong
|
|
CHARACTER(len=256) :: dft_buffer ! needed to allow the string defining the
|
|
! DFT flavor to be longer than upf%dft
|
|
! (currntly 25) without getting iotk upset.
|
|
! An error message is issued if trimmed
|
|
! dft_buffer exceeds upf%dft size.
|
|
INTEGER :: len_buffer
|
|
!
|
|
INTEGER :: nw
|
|
TYPE(Node), POINTER :: hdrNode
|
|
CHARACTER(LEN=256) :: attr
|
|
TYPE(DOMException) :: ex
|
|
!
|
|
! Read HEADER section with some initialization data
|
|
hdrNode => item( getElementsByTagname(u, 'PP_HEADER'), 0 )
|
|
IF ( hasAttribute( hdrNode, 'generated') ) THEN
|
|
CALL extractDataAttribute(hdrNode, 'generated', upf%generated)
|
|
ELSE
|
|
upf%generated = ' '
|
|
END IF
|
|
IF ( hasAttribute( hdrNode, 'author') ) THEN
|
|
CALL extractDataAttribute(hdrNode, 'author', upf%author)
|
|
ELSE
|
|
upf%author = 'anonymous'
|
|
END IF
|
|
IF ( hasAttribute( hdrNode, 'date') ) THEN
|
|
CALL extractDataAttribute(hdrNode, 'date', upf%date)
|
|
ELSE
|
|
upf%date = ' '
|
|
END IF
|
|
IF ( hasAttribute( hdrNode, 'comment') ) THEN
|
|
CALL extractDataAttribute(hdrNode, 'comment', upf%comment)
|
|
ELSE
|
|
upf%comment = ' '
|
|
END IF
|
|
!
|
|
CALL extractDataAttribute(hdrNode, 'element', upf%psd)
|
|
CALL extractDataAttribute(hdrNode, 'pseudo_type', upf%typ)
|
|
CALL extractDataAttribute(hdrNode, 'relativistic', upf%rel)
|
|
!
|
|
CALL extractDataAttribute(hdrNode, 'is_ultrasoft', upf%tvanp, iostat = ios )
|
|
IF ( ios /= 0 ) THEN
|
|
CALL extractDataAttribute(hdrNode, 'is_ultrasoft', attr)
|
|
upf%tvanp = ( INDEX (attr, 'T') > 0 )
|
|
END IF
|
|
CALL extractDataAttribute(hdrNode, 'is_paw', upf%tpawp, iostat = ios)
|
|
IF ( ios /= 0 ) THEN
|
|
CALL extractDataAttribute(hdrNode, 'is_paw', attr)
|
|
upf%tpawp = ( INDEX (attr, 'T') > 0 )
|
|
END IF
|
|
!
|
|
IF ( hasAttribute ( hdrNode, 'is_coulomb')) THEN
|
|
CALL extractDataAttribute(hdrNode, 'is_coulomb', upf%tcoulombp, iostat = ios)
|
|
IF ( ios /= 0 ) THEN
|
|
CALL extractDataAttribute ( hdrNode, 'is_coulomb', attr)
|
|
upf%tcoulombp = ( INDEX ( attr, 'T') > 0 )
|
|
END IF
|
|
ELSE
|
|
upf%tcoulombp = .FALSE.
|
|
END IF
|
|
!
|
|
IF ( hasAttribute (hdrNode, 'has_so') ) THEN
|
|
CALL extractDataAttribute(hdrNode, 'has_so', upf%has_so , IOSTAT = ios )
|
|
IF ( ios /=0) THEN
|
|
CALL extractDataAttribute(hdrNode, 'has_so', attr)
|
|
upf%has_so = ( INDEX ( attr, 'T') > 0 )
|
|
END IF
|
|
ELSE
|
|
upf%has_so = .false.
|
|
END IF
|
|
IF ( hasAttribute( hdrNode, 'has_wfc') ) THEN
|
|
CALL extractDataAttribute(hdrNode, 'has_wfc', upf%has_wfc, IOSTAT = ios)
|
|
IF ( ios /= 0 ) THEN
|
|
CALL extractDataAttribute (hdrNode, 'has_wfc', attr)
|
|
upf%has_wfc = ( INDEX(attr, 'T' ) > 0 )
|
|
END IF
|
|
ELSE
|
|
upf%has_wfc = upf%tpawp
|
|
END IF
|
|
IF ( hasAttribute ( hdrNode, 'has_gipaw' )) THEN
|
|
CALL extractDataAttribute(hdrNode, 'has_gipaw', upf%has_gipaw, IOSTAT = ios )
|
|
IF ( ios /= 0 ) THEN
|
|
CALL extractDataAttribute(hdrNode, 'has_gipaw', attr )
|
|
upf%has_gipaw = ( INDEX ( attr, 'T') > 0 )
|
|
END IF
|
|
ELSE
|
|
upf%has_gipaw = .false.
|
|
END IF
|
|
!EMINE
|
|
IF ( hasAttribute ( hdrNode, 'paw_as_gipaw') ) THEN
|
|
CALL extractDataAttribute(hdrNode, 'paw_as_gipaw', upf%paw_as_gipaw, IOSTAT = ios )
|
|
IF ( ios /= 0 ) THEN
|
|
CALL extractDataAttribute(hdrNode, 'paw_as_gipaw', attr )
|
|
upf%paw_as_gipaw = ( INDEX(attr, 'T') > 0 )
|
|
END IF
|
|
ELSE
|
|
upf%paw_as_gipaw = .false.
|
|
END IF
|
|
!
|
|
CALL extractDataAttribute(hdrNode, 'core_correction',upf%nlcc, IOSTAT = ios)
|
|
IF ( ios /= 0 ) THEN
|
|
CALL extractDataAttribute(hdrNode, 'core_correction', attr )
|
|
upf%nlcc = ( INDEX( attr, 'T') > 0 )
|
|
END IF
|
|
!
|
|
CALL extractDataAttribute(hdrNode, 'functional', dft_buffer)
|
|
len_buffer=len_trim(dft_buffer)
|
|
IF (len_buffer > len(upf%dft)) &
|
|
CALL errore('read_upf_v2','String defining DFT is too long',len_buffer)
|
|
upf%dft=TRIM(dft_buffer)
|
|
!
|
|
CALL extractDataAttribute (hdrNode, 'z_valence', upf%zp)
|
|
IF ( hasAttribute (hdrNode, 'total_psenergy') ) THEN
|
|
CALL extractDataAttribute (hdrNode, 'total_psenergy', upf%etotps)
|
|
ELSE
|
|
upf%etotps = 0._dp
|
|
END IF
|
|
IF ( hasAttribute (hdrNode, 'wfc_cutoff') ) THEN
|
|
CALL extractDataAttribute (hdrNode, 'wfc_cutoff', upf%ecutwfc )
|
|
ELSE
|
|
upf%ecutwfc = 0._dp
|
|
END IF
|
|
IF ( hasAttribute (hdrNode, 'rho_cutoff') ) THEN
|
|
CALL extractDataAttribute (hdrNode, 'rho_cutoff', upf%ecutrho)
|
|
ELSE
|
|
upf%ecutrho = 0._dp
|
|
END IF
|
|
IF ( hasAttribute ( hdrNode, 'l_max' ) ) THEN
|
|
CALL extractDataAttribute (hdrNode, 'l_max', upf%lmax)
|
|
ELSE
|
|
upf%lmax =0
|
|
END IF
|
|
IF ( hasAttribute ( hdrNode, 'l_max_rho') ) THEN
|
|
CALL extractDataAttribute (hdrNode, 'l_max_rho', upf%lmax_rho)
|
|
ELSE
|
|
upf%lmax_rho = 2*upf%lmax
|
|
END IF
|
|
IF ( hasAttribute ( hdrNode, 'l_local') ) THEN
|
|
CALL extractDataAttribute (hdrNode, 'l_local', upf%lloc )
|
|
ELSE
|
|
upf%lloc = 0
|
|
END IF
|
|
CALL extractDataAttribute (hdrNode, 'mesh_size', upf%mesh)
|
|
CALL extractDataAttribute (hdrNode, 'number_of_wfc', upf%nwfc)
|
|
CALL extractDataAttribute (hdrNode, 'number_of_proj', upf%nbeta)
|
|
!
|
|
RETURN
|
|
END SUBROUTINE read_upf_header
|
|
!
|
|
SUBROUTINE read_upf_mesh(u, upf, grid)
|
|
USE radial_grids, ONLY: allocate_radial_grid
|
|
IMPLICIT NONE
|
|
TYPE (Node),POINTER,INTENT(IN) :: u ! i/o unit
|
|
TYPE(pseudo_upf),INTENT(INOUT) :: upf ! the pseudo data
|
|
TYPE(radial_grid_type),OPTIONAL,INTENT(INOUT),TARGET :: grid
|
|
!
|
|
INTEGER :: ierr ! /= 0 if something went wrong
|
|
TYPE (Node),POINTER :: mshNode, locNode
|
|
!
|
|
LOGICAL :: found
|
|
!
|
|
mshNode => item( getElementsByTagname(u, 'PP_MESH'),0 )
|
|
IF ( hasAttribute(mshNode, 'dx')) CALL extractDataAttribute(mshNode, 'dx', upf%dx )
|
|
IF ( hasAttribute (mshNode, 'mesh')) &
|
|
CALL extractDataAttribute(mshNode, 'mesh', upf%mesh )
|
|
IF ( hasAttribute ( mshNode, 'xmin') ) CALL extractDataAttribute(mshNode, 'xmin', upf%xmin )
|
|
IF ( hasAttribute ( mshNode, 'rmax') ) CALL extractDataAttribute(mshNode, 'rmax', upf%rmax )
|
|
IF ( hasAttribute ( mshNode, 'zmesh') ) CALL extractDataAttribute(mshNode, 'zmesh',upf%zmesh )
|
|
IF (present(grid)) THEN
|
|
CALL allocate_radial_grid(grid, upf%mesh)
|
|
!
|
|
grid%dx = upf%dx
|
|
grid%mesh = upf%mesh
|
|
grid%xmin = upf%xmin
|
|
grid%rmax = upf%rmax
|
|
grid%zmesh = upf%zmesh
|
|
!
|
|
upf%grid => grid
|
|
upf%r => upf%grid%r
|
|
upf%rab => upf%grid%rab
|
|
ELSE
|
|
ALLOCATE( upf%r( upf%mesh ), upf%rab( upf%mesh ) )
|
|
ENDIF
|
|
!
|
|
locNode => item( getElementsByTagname( mshNode, 'PP_R'), 0 )
|
|
CALL extractDataContent(locNode, upf%r(1:upf%mesh))
|
|
!
|
|
locNode => item(getElementsByTagname( mshNode, 'PP_RAB'), 0)
|
|
CALL extractDataContent(locNode, upf%rab(1:upf%mesh))
|
|
!
|
|
IF (present(grid)) THEN
|
|
! Reconstruct additional grids
|
|
upf%grid%r2 = upf%r**2
|
|
upf%grid%sqr = sqrt(upf%r)
|
|
! Prevent FP error if r(1) = 0
|
|
IF ( upf%r(1) > 1.0D-16) THEN
|
|
upf%grid%rm1 = upf%r**(-1)
|
|
upf%grid%rm2 = upf%r**(-2)
|
|
upf%grid%rm3 = upf%r**(-3)
|
|
ELSE
|
|
upf%grid%rm1(1) =0.0_dp
|
|
upf%grid%rm2(1) =0.0_dp
|
|
upf%grid%rm3(1) =0.0_dp
|
|
upf%grid%rm1(2:) = upf%r(2:)**(-1)
|
|
upf%grid%rm2(2:) = upf%r(2:)**(-2)
|
|
upf%grid%rm3(2:) = upf%r(2:)**(-3)
|
|
END IF
|
|
ENDIF
|
|
!
|
|
RETURN
|
|
END SUBROUTINE read_upf_mesh
|
|
!
|
|
SUBROUTINE read_upf_nonlocal(u, upf)
|
|
IMPLICIT NONE
|
|
TYPE(Node),POINTER,INTENT(IN) :: u ! i/o unit
|
|
TYPE(pseudo_upf),INTENT(INOUT) :: upf ! the pseudo data
|
|
!
|
|
!
|
|
TYPE (Node),POINTER :: nlcNode, locNode,locNode1, locNode2, locNode3
|
|
TYPE (nodeList),POINTER :: tmpList
|
|
INTEGER :: nb,mb,ln,lm,l,nmb,ierr=0
|
|
!INTEGER :: nb_=-1,mb_=-1,l_=-1,nmb_=-1
|
|
REAL(DP):: zeros(upf%mesh)
|
|
REAL(DP), ALLOCATABLE :: tmp_dbuffer(:)
|
|
LOGICAL :: isnull, found
|
|
CHARACTER(LEN = 256 ) :: attr
|
|
INTEGER :: ios
|
|
zeros=0._dp
|
|
!
|
|
! modified by AF
|
|
!IF (upf%tcoulombp) RETURN
|
|
IF (upf%tcoulombp) upf%nbeta = 0
|
|
!
|
|
! Allocate space for non-local part
|
|
IF ( upf%nbeta == 0) THEN
|
|
upf%nqf = 0
|
|
upf%nqlc= 0
|
|
upf%qqq_eps= -1._dp
|
|
upf%kkbeta = 0
|
|
ALLOCATE( upf%kbeta(1), &
|
|
upf%lll(1), &
|
|
upf%beta(upf%mesh,1), &
|
|
upf%dion(1,1), &
|
|
upf%rinner(1), &
|
|
upf%qqq(1,1), &
|
|
upf%qfunc(upf%mesh,1),&
|
|
upf%qfcoef(1,1,1,1), &
|
|
upf%rcut(1), &
|
|
upf%rcutus(1), &
|
|
upf%els_beta(1) )
|
|
RETURN
|
|
END IF
|
|
!
|
|
! <AF>
|
|
|
|
nlcNode => item ( getElementsByTagname( u, 'PP_NONLOCAL'), 0 )
|
|
!
|
|
ALLOCATE( upf%kbeta(upf%nbeta), &
|
|
upf%lll(upf%nbeta), &
|
|
upf%beta(upf%mesh, upf%nbeta), &
|
|
upf%dion(upf%nbeta, upf%nbeta),&
|
|
upf%rcut(upf%nbeta), &
|
|
upf%rcutus(upf%nbeta), &
|
|
upf%els_beta(upf%nbeta) )
|
|
|
|
!
|
|
! Read the projectors:
|
|
locNode2 => getFirstChild(nlcNode)
|
|
nb = 0
|
|
DO
|
|
IF (.NOT. ASSOCIATED( locNode2) ) EXIT
|
|
locNode => locNode2
|
|
locNode2 => getNextSibling(locNode)
|
|
IF (getNodeType( locNode) .NE. ELEMENT_NODE ) CYCLE
|
|
IF ( INDEX(getTagName(locNode), 'PP_BETA') .LE. 0 ) CYCLE
|
|
nb = nb + 1
|
|
CALL extractDataContent(locNode, upf%beta(:, nb))
|
|
IF ( hasAttribute( locNode, 'label') ) THEN
|
|
CALL extractDataAttribute(locNode, 'label', upf%els_beta(nb))
|
|
ELSE
|
|
upf%els_beta(nb) ='Xn'
|
|
END IF
|
|
CALL extractDataAttribute(locNode, 'angular_momentum', upf%lll(nb))
|
|
IF ( hasAttribute( locNode,'cutoff_radius_index' )) THEN
|
|
CALL extractDataAttribute(locNode, 'cutoff_radius_index', upf%kbeta(nb))
|
|
ELSE
|
|
upf%kbeta = upf%mesh
|
|
END IF
|
|
IF ( hasAttribute( locNode,'cutoff_radius' )) THEN
|
|
CALL extractDataAttribute(locNode, 'cutoff_radius', upf%rcut(nb) )
|
|
ELSE
|
|
upf%rcut(nb) = 0._dp
|
|
END IF
|
|
IF ( hasAttribute( locNode,'ultrasoft_cutoff_radius' )) THEN
|
|
CALL extractDataAttribute(locNode, 'ultrasoft_cutoff_radius', upf%rcutus(nb))
|
|
ELSE
|
|
upf%rcutus(nb) = 0._dp
|
|
END IF
|
|
!
|
|
! Old version of UPF PPs v.2 contained an error in the tag.
|
|
! To be able to read the old PPs we need the following
|
|
!
|
|
IF ( upf%rcutus(nb)==0._DP) THEN
|
|
IF ( hasAttribute( locNode,'norm_conserving_radius' )) THEN
|
|
CALL extractDataAttribute(locNode,'norm_conserving_radius',upf%rcutus(nb))
|
|
ELSE
|
|
upf%rcutus(nb) = 0._dp
|
|
END IF
|
|
END IF
|
|
ENDDO
|
|
!
|
|
! Read the hamiltonian terms D_ij
|
|
locNode => item( getElementsByTagname(nlcNode, 'PP_DIJ'),0)
|
|
CALL extractDataContent(locNode, upf%dion)
|
|
! CALL iotk_scan_attr(attr, 'non_zero_elements', upf%nd)
|
|
!
|
|
! Read the augmentation charge section
|
|
augmentation : &
|
|
IF(upf%tvanp .or. upf%tpawp) THEN
|
|
!
|
|
locNode => item(getElementsByTagname(nlcNode, 'PP_AUGMENTATION'),0)
|
|
CALL extractDataAttribute(locNode, 'q_with_l', upf%q_with_l, IOSTAT = ios )
|
|
IF ( ios /= 0) THEN
|
|
CALL extractDataAttribute(locNode, 'q_with_l', attr )
|
|
upf%q_with_l = ( INDEX ( attr, 'T') > 0)
|
|
END IF
|
|
CALL extractDataAttribute(locNode, 'nqf', upf%nqf)
|
|
IF (hasAttribute(locNode, 'nqlc') ) THEN
|
|
CALL extractDataAttribute(locNode, 'nqlc', upf%nqlc)
|
|
ELSE
|
|
upf%nqlc =2*upf%lmax+1
|
|
END IF
|
|
IF (upf%tpawp) THEN
|
|
IF (hasAttribute(locNode, 'shape') ) THEN
|
|
CALL extractDataAttribute(locNode,'shape', upf%paw%augshape)
|
|
ELSE
|
|
upf%paw%augshape ='UNKNOWN'
|
|
END IF
|
|
IF (hasAttribute(locNode, 'cutoff_r') ) THEN
|
|
CALL extractDataAttribute(locNode,'cutoff_r', upf%paw%raug )
|
|
ELSE
|
|
upf%paw%raug = 0._dp
|
|
END IF
|
|
IF (hasAttribute(locNode, 'cutoff_r_index') ) THEN
|
|
CALL extractDataAttribute(locNode,'cutoff_r_index', upf%paw%iraug)
|
|
ELSE
|
|
upf%paw%iraug =upf%mesh
|
|
END IF
|
|
IF (hasAttribute(locNode, 'l_max_aug') ) THEN
|
|
CALL extractDataAttribute(locNode,'l_max_aug', upf%paw%lmax_aug)
|
|
ELSE
|
|
upf%paw%lmax_aug =upf%lmax_rho
|
|
END IF
|
|
ENDIF
|
|
! a negative number means that all qfunc are stored
|
|
IF (hasAttribute(locNode, 'augmentation_epsilon' ) ) THEN
|
|
CALL extractDataAttribute(locNode,'augmentation_epsilon',upf%qqq_eps)
|
|
ELSE
|
|
upf%qqq_eps = -1._dp
|
|
END IF
|
|
!
|
|
ALLOCATE( upf%rinner( upf%nqlc ) )
|
|
ALLOCATE( upf%qqq ( upf%nbeta, upf%nbeta ) )
|
|
IF ( upf%q_with_l ) THEN
|
|
ALLOCATE( upf%qfuncl ( upf%mesh, upf%nbeta*(upf%nbeta+1)/2, 0:2*upf%lmax ) )
|
|
upf%qfuncl=0._dp
|
|
ELSE
|
|
ALLOCATE( upf%qfunc (upf%mesh, upf%nbeta*(upf%nbeta+1)/2) )
|
|
ENDIF
|
|
!
|
|
! Read the integrals of the Q functions
|
|
locNode2 => item( getElementsByTagname( locNode, 'PP_Q'), 0)
|
|
CALL extractDataContent(locNode2, upf%qqq )
|
|
!
|
|
! read charge multipoles (only if PAW)
|
|
IF( upf%tpawp ) THEN
|
|
ALLOCATE(upf%paw%augmom(upf%nbeta,upf%nbeta, 0:2*upf%lmax))
|
|
ALLOCATE( tmp_dbuffer(upf%nbeta*upf%nbeta*(2*upf%lmax+1)) )
|
|
locNode2 => item( getElementsByTagname(locNode,'PP_MULTIPOLES'), 0)
|
|
CALL extractDataContent(locNode2, tmp_dbuffer)
|
|
upf%paw%augmom=reshape(tmp_dbuffer, [upf%nbeta,upf%nbeta,2*upf%lmax+1])
|
|
DEALLOCATE (tmp_dbuffer)
|
|
ENDIF
|
|
!
|
|
! Read polinomial coefficients for Q_ij expansion at small radius
|
|
IF(upf%nqf <= 0) THEN
|
|
upf%rinner(:) = 0._dp
|
|
ALLOCATE( upf%qfcoef(1,1,1,1) )
|
|
upf%qfcoef = 0._dp
|
|
ELSE
|
|
ALLOCATE( upf%qfcoef( MAX( upf%nqf,1 ), upf%nqlc, upf%nbeta, upf%nbeta ) )
|
|
ALLOCATE(tmp_dbuffer(MAX( upf%nqf,1 )*upf%nqlc*upf%nbeta*upf%nbeta))
|
|
locNode2=> item(getElementsByTagname(locNode, 'PP_QFCOEF'),0)
|
|
CALL extractDataContent(locNode2, tmp_dbuffer)
|
|
upf%qfcoef = reshape(tmp_dbuffer,[size(upf%qfcoef,1),size(upf%qfcoef,2),&
|
|
size(upf%qfcoef,3),size(upf%qfcoef,4)])
|
|
DEALLOCATE(tmp_dbuffer)
|
|
locNode2 => item(getElementsByTagname(locNode, 'PP_RINNER'),0)
|
|
CALL extractDataContent(locNode2, upf%rinner)
|
|
ENDIF
|
|
!
|
|
! Read augmentation charge Q_ij
|
|
ultrasoft_or_paw : &
|
|
IF( upf%tvanp) THEN
|
|
locNode3 => getFirstChild(locNode)
|
|
IF (upf%q_with_l) THEN
|
|
upf%qfuncl = 0._dp
|
|
ELSE
|
|
upf%qfunc = 0._dp
|
|
END IF
|
|
search_for_qij: DO
|
|
IF ( .NOT. ASSOCIATED(locNode3) ) EXIT search_for_qij
|
|
locNode2 => locNode3
|
|
locNode3 => getNextSibling(locNode2)
|
|
IF (getNodeType(locNode2) .NE. ELEMENT_NODE) CYCLE search_for_qij
|
|
!
|
|
IF ( INDEX( getTagName(locNode2), 'PP_QIJ') .LE. 0) CYCLE search_for_qij
|
|
CALL extractDataAttribute(locNode2, 'composite_index', nmb)
|
|
IF (upf%q_with_l) THEN
|
|
CALL extractDataAttribute(locNode2, 'angular_momentum', l)
|
|
CALL extractDataContent( locNode2, upf%qfuncl(:, nmb,l))
|
|
IF (upf%tpawp) upf%qfuncl(upf%paw%iraug+1:,nmb,l) = 0._DP
|
|
ELSE
|
|
CALL extractDataContent ( locNode2, upf%qfunc(:,nmb))
|
|
END IF
|
|
END DO search_for_qij
|
|
!
|
|
ENDIF ultrasoft_or_paw
|
|
!
|
|
!
|
|
ENDIF augmentation
|
|
!
|
|
! Maximum radius of beta projector: outer radius to integrate
|
|
upf%kkbeta = MAXVAL(upf%kbeta(1:upf%nbeta))
|
|
! For PAW augmentation charge may extend a bit further:
|
|
IF(upf%tpawp) upf%kkbeta = MAX(upf%kkbeta, upf%paw%iraug)
|
|
!
|
|
!
|
|
RETURN
|
|
END SUBROUTINE read_upf_nonlocal
|
|
!
|
|
SUBROUTINE read_upf_pswfc(u, upf)
|
|
IMPLICIT NONE
|
|
TYPE(Node), POINTER, INTENT(IN) :: u ! pointer to root node
|
|
TYPE(pseudo_upf),INTENT(INOUT) :: upf ! the pseudo data
|
|
INTEGER :: ierr ! /= 0 if something went wrong
|
|
!
|
|
!
|
|
INTEGER :: nw
|
|
TYPE(Node),POINTER :: pswfcNode, locNode, locNode2
|
|
!
|
|
pswfcNode => item(getElementsByTagname(u, 'PP_PSWFC'), 0)
|
|
!
|
|
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) &
|
|
)
|
|
!
|
|
locNode2 => getFirstChild ( pswfcNode )
|
|
nw = 0
|
|
DO
|
|
IF (.NOT. ASSOCIATED( locNode2) ) EXIT
|
|
locNode => locNode2
|
|
locNode2 => getNextSibling(locNode)
|
|
IF (getNodeType(locNode) .NE. ELEMENT_NODE ) CYCLE
|
|
IF ( INDEX ( getTagName(locNode),'PP_CHI') .LE. 0 ) CYCLE
|
|
nw = nw + 1
|
|
IF ( nw .GT. upf%nwfc ) THEN
|
|
CALL infomsg('pseudo '//trim(upf%psd), "too many chi found in pswfc" )
|
|
EXIT
|
|
END IF
|
|
IF ( hasAttribute (locNode, 'label')) THEN
|
|
CALL extractDataAttribute(locNode, 'label', upf%els(nw) )
|
|
ELSE
|
|
upf%els(nw) = 'Xn'
|
|
END IF
|
|
CALL extractDataAttribute(locNode, 'l', upf%lchi(nw))
|
|
CALL extractDataAttribute(locNode, 'occupation', upf%oc(nw))
|
|
IF ( hasAttribute(locNode, 'n')) THEN
|
|
CALL extractDataAttribute(locNode, 'n', upf%nchi(nw))
|
|
ELSE
|
|
upf%nchi = upf%lchi(nw)-1
|
|
END IF
|
|
IF ( hasAttribute(locNode, 'pseudo_energy') ) THEN
|
|
CALL extractDataAttribute(locNode, 'pseudo_energy', upf%epseu(nw) )
|
|
ELSE
|
|
upf%epseu(nw) = 0._dp
|
|
END IF
|
|
IF ( hasAttribute( locNode,'cutoff_radius') ) THEN
|
|
CALL extractDataAttribute(locNode, 'cutoff_radius', upf%rcut_chi(nw) )
|
|
ELSE
|
|
upf%rcut_chi(nw) =0._dp
|
|
END IF
|
|
IF ( hasAttribute(locNode, 'ultrasoft_cutoff_radius') ) THEN
|
|
CALL extractDataAttribute(locNode, 'ultrasoft_cutoff_radius', upf%rcutus_chi(nw))
|
|
ELSE
|
|
upf%rcutus_chi(nw) =0._dp
|
|
END IF
|
|
CALL extractDataContent(locNode, upf%chi(:,nw) )
|
|
ENDDO
|
|
!
|
|
RETURN
|
|
END SUBROUTINE read_upf_pswfc
|
|
|
|
SUBROUTINE read_upf_full_wfc(u, upf)
|
|
IMPLICIT NONE
|
|
TYPE(Node),POINTER, INTENT(IN) :: u ! parent node
|
|
TYPE(pseudo_upf),INTENT(INOUT) :: upf ! the pseudo data
|
|
INTEGER :: ierr ! /= 0 if something went wrong
|
|
!
|
|
LOGICAL :: exst
|
|
!
|
|
INTEGER :: nbae, nbae_rel, nbps
|
|
TYPE(Node),POINTER :: fllwfNode, locNode, locNode2
|
|
!
|
|
IF(.not. upf%has_wfc) RETURN
|
|
!
|
|
fllwfNode => item(getElementsByTagname (u, 'PP_FULL_WFC'), 0)
|
|
!
|
|
ALLOCATE( upf%aewfc(upf%mesh, upf%nbeta) )
|
|
ALLOCATE( upf%pswfc(upf%mesh, upf%nbeta) )
|
|
IF (upf%has_so .and. upf%tpawp) THEN
|
|
ALLOCATE( upf%paw%aewfc_rel(upf%mesh, upf%nbeta) )
|
|
upf%paw%aewfc_rel = 0._dp
|
|
END IF
|
|
locNode2 => getFirstChild(fllwfNode)
|
|
nbae=0
|
|
nbae_rel = 0
|
|
nbps = 0
|
|
DO
|
|
IF ( .NOT. ASSOCIATED ( locNode2) ) EXIT
|
|
locNode => locNode2
|
|
locNode2=> getNextSibling(locNode)
|
|
IF (getNodeType(locNode) .NE. ELEMENT_NODE) CYCLE
|
|
IF (INDEX(getTagName(locNode), 'PP_AEWFC_REL') .GT. 0 ) THEN
|
|
nbae_rel = nbae_rel+1
|
|
IF (nbae_rel .GT. upf%nbeta ) THEN
|
|
CYCLE
|
|
ELSE
|
|
CALL extractDataContent(locNode, upf%paw%aewfc_rel(:,nbae_rel))
|
|
END IF
|
|
ELSE IF (INDEX(getTagName(locNode),'PP_AEWFC') .GT. 0) THEN
|
|
nbae = nbae +1
|
|
IF (nbae .GT. upf%nbeta) THEN
|
|
CYCLE
|
|
ELSE
|
|
CALL extractDataContent(locNode, upf%aewfc(:,nbae))
|
|
END IF
|
|
ELSE IF (INDEX(getTagName(locNode), 'PP_PSWFC') .GT. 0) THEN
|
|
nbps = nbps + 1
|
|
IF ( nbps .LE. upf%nbeta ) THEN
|
|
CALL extractDataContent(locNode, upf%pswfc(:, nbps) )
|
|
END IF
|
|
END IF
|
|
ENDDO
|
|
END SUBROUTINE read_upf_full_wfc
|
|
|
|
!
|
|
SUBROUTINE read_upf_spin_orb(u, upf)
|
|
IMPLICIT NONE
|
|
TYPE(Node), POINTER, INTENT(IN) :: u ! parent node pointer
|
|
TYPE(pseudo_upf),INTENT(INOUT) :: upf ! the pseudo data
|
|
INTEGER :: ierr ! /= 0 if something went wrong
|
|
|
|
!
|
|
!
|
|
INTEGER :: nw, nb
|
|
TYPE(Node), POINTER :: soNode, locNode, locNode2
|
|
!
|
|
IF (.not. upf%has_so) RETURN
|
|
!
|
|
soNode => item(getElementsByTagName(u, 'PP_SPIN_ORB'), 0)
|
|
!
|
|
ALLOCATE (upf%nn(upf%nwfc))
|
|
ALLOCATE (upf%jchi(upf%nwfc))
|
|
!
|
|
ALLOCATE(upf%jjj(upf%nbeta))
|
|
!
|
|
locNode2=> getFirstChild(soNode)
|
|
nw = 0
|
|
nb = 0
|
|
DO
|
|
IF (.NOT. ASSOCIATED(locNode2)) EXIT
|
|
locNode => locNode2
|
|
locNode2 => getNextSibling(locNode)
|
|
IF ( getNodeType(locNode) .NE. ELEMENT_NODE ) CYCLE
|
|
select_tag: IF ( INDEX(getTagName(locNode),'PP_RELWFC') .GT. 0) THEN
|
|
nw = nw + 1
|
|
IF (nw .LE. upf%nwfc ) THEN
|
|
CALL extractDataAttribute (locNode, 'nn', upf%nn(nw))
|
|
CALL extractDataAttribute (locNode, 'jchi', upf%jchi(nw))
|
|
!extraxtDataAttribute(attr, 'els', upf%els(nw)) ! already read
|
|
!extraxtDataAttribute(attr, 'lchi', upf%lchi(nw)) ! already read
|
|
!extraxtDataAttribute(attr, 'oc', upf%oc(nw)) ! already read
|
|
END IF
|
|
ELSE IF (INDEX(getTagName(locNode),'PP_RELBETA') .GT. 0) THEN
|
|
nb = nb + 1
|
|
IF (nb .LE. upf%nbeta ) THEN
|
|
CALL extractDataAttribute(locNode, 'lll', upf%lll(nb))
|
|
CALL extractDataAttribute(locNode, 'jjj', upf%jjj(nb))
|
|
END IF
|
|
END IF select_tag
|
|
ENDDO
|
|
!
|
|
RETURN
|
|
END SUBROUTINE read_upf_spin_orb
|
|
!
|
|
SUBROUTINE read_upf_paw(u, upf)
|
|
IMPLICIT NONE
|
|
TYPE(Node), POINTER, INTENT(IN) :: u !
|
|
TYPE(pseudo_upf),INTENT(INOUT) :: upf ! the pseudo data
|
|
INTEGER :: ierr ! /= 0 if something went wrong
|
|
!
|
|
TYPE(Node), POINTER :: pawNode, locNode
|
|
INTEGER :: nb,nb1
|
|
|
|
IF (.not. upf%tpawp ) RETURN
|
|
|
|
pawNode => item(getElementsByTagname(u, 'PP_PAW'), 0)
|
|
CALL extractDataAttribute(pawNode, 'paw_data_format', upf%paw_data_format)
|
|
IF(upf%paw_data_format /= 2) &
|
|
CALL errore('read_upf_v2::paw',&
|
|
'Unknown format of PAW data.',1)
|
|
IF (hasAttribute(pawNode, 'core_energy')) THEN
|
|
CALL extractDataAttribute(pawNode, 'core_energy', upf%paw%core_energy)
|
|
ELSE
|
|
upf%paw%core_energy = 0._dp
|
|
END IF
|
|
!
|
|
! Full occupation (not only > 0 ones)
|
|
ALLOCATE( upf%paw%oc(upf%nbeta) )
|
|
locNode => item(getElementsByTagname(pawNode, 'PP_OCCUPATIONS'), 0)
|
|
CALL extractDataContent(locNode, upf%paw%oc)
|
|
|
|
!
|
|
! All-electron core charge
|
|
ALLOCATE( upf%paw%ae_rho_atc(upf%mesh) )
|
|
locNode => item(getElementsByTagname(pawNode, 'PP_AE_NLCC'), 0)
|
|
CALL extractDataContent(locNode, upf%paw%ae_rho_atc)
|
|
|
|
!
|
|
! All-electron local potential
|
|
ALLOCATE( upf%paw%ae_vloc(upf%mesh) )
|
|
locNode => item(getElementsByTagname( pawNode, 'PP_AE_VLOC'), 0)
|
|
CALL extractDataContent(locNode, upf%paw%ae_vloc)
|
|
|
|
!
|
|
ALLOCATE(upf%paw%pfunc(upf%mesh, upf%nbeta,upf%nbeta) )
|
|
upf%paw%pfunc(:,:,:) = 0._dp
|
|
IF (upf%has_so) THEN
|
|
ALLOCATE(upf%paw%pfunc_rel(upf%mesh, upf%nbeta,upf%nbeta) )
|
|
upf%paw%pfunc_rel(:,:,:) = 0._dp
|
|
ENDIF
|
|
DO nb=1,upf%nbeta
|
|
DO nb1=1,nb
|
|
upf%paw%pfunc (1:upf%mesh, nb, nb1) = &
|
|
upf%aewfc(1:upf%mesh, nb) * upf%aewfc(1:upf%mesh, nb1)
|
|
IF (upf%has_so) THEN
|
|
upf%paw%pfunc_rel (1:upf%paw%iraug, nb, nb1) = &
|
|
upf%paw%aewfc_rel(1:upf%paw%iraug, nb) * &
|
|
upf%paw%aewfc_rel(1:upf%paw%iraug, nb1)
|
|
!
|
|
! The small component is added to pfunc. pfunc_rel is useful only
|
|
! to add a small magnetic contribution
|
|
!
|
|
upf%paw%pfunc (1:upf%paw%iraug, nb, nb1) = &
|
|
upf%paw%pfunc (1:upf%paw%iraug, nb, nb1) + &
|
|
upf%paw%pfunc_rel (1:upf%paw%iraug, nb, nb1)
|
|
ENDIF
|
|
upf%paw%pfunc(upf%paw%iraug+1:,nb,nb1) = 0._dp
|
|
!
|
|
upf%paw%pfunc (1:upf%mesh, nb1, nb) = upf%paw%pfunc (1:upf%mesh, nb, nb1)
|
|
IF (upf%has_so) upf%paw%pfunc_rel (1:upf%mesh, nb1, nb) = &
|
|
upf%paw%pfunc_rel (1:upf%mesh, nb, nb1)
|
|
ENDDO
|
|
ENDDO
|
|
!
|
|
! Pseudo wavefunctions (not only the ones for oc > 0)
|
|
! All-electron wavefunctions
|
|
ALLOCATE(upf%paw%ptfunc(upf%mesh, upf%nbeta,upf%nbeta) )
|
|
upf%paw%ptfunc(:,:,:) = 0._dp
|
|
DO nb=1,upf%nbeta
|
|
DO nb1=1,upf%nbeta
|
|
upf%paw%ptfunc (1:upf%mesh, nb, nb1) = &
|
|
upf%pswfc(1:upf%mesh, nb) * upf%pswfc(1:upf%mesh, nb1)
|
|
upf%paw%ptfunc(upf%paw%iraug+1:,nb,nb1) = 0._dp
|
|
!
|
|
upf%paw%ptfunc (1:upf%mesh, nb1, nb) = upf%paw%ptfunc (1:upf%mesh, nb, nb1)
|
|
ENDDO
|
|
ENDDO
|
|
!
|
|
RETURN
|
|
END SUBROUTINE read_upf_paw
|
|
!
|
|
SUBROUTINE read_upf_gipaw(u, upf)
|
|
IMPLICIT NONE
|
|
TYPE(Node), POINTER, INTENT(IN) :: u ! i/o unit
|
|
TYPE(pseudo_upf),INTENT(INOUT) :: upf ! the pseudo data
|
|
INTEGER :: ierr ! /= 0 if something went wrong
|
|
!
|
|
INTEGER :: nb
|
|
TYPE(Node), POINTER :: gpawNode, locNode, locNode2, locNode3, locNode4
|
|
TYPE(NodeList), POINTER :: locList
|
|
IF (.not. upf%has_gipaw ) RETURN
|
|
!
|
|
gpawNode => item(getElementsByTagname(u, 'PP_GIPAW'), 0)
|
|
CALL extractDataAttribute(gpawNode, 'gipaw_data_format', upf%gipaw_data_format)
|
|
IF(upf%gipaw_data_format /= 2) &
|
|
CALL infomsg('read_upf_v2::gipaw','Unknown format version')
|
|
!
|
|
locNode => item(getElementsByTagname(gpawNode, 'PP_GIPAW_CORE_ORBITALS'), 0)
|
|
CALL extractDataAttribute(locNode, 'number_of_core_orbitals', upf%gipaw_ncore_orbitals)
|
|
ALLOCATE ( upf%gipaw_core_orbital_n(upf%gipaw_ncore_orbitals) )
|
|
ALLOCATE ( upf%gipaw_core_orbital_el(upf%gipaw_ncore_orbitals) )
|
|
ALLOCATE ( upf%gipaw_core_orbital_l(upf%gipaw_ncore_orbitals) )
|
|
ALLOCATE ( upf%gipaw_core_orbital(upf%mesh,upf%gipaw_ncore_orbitals) )
|
|
locNode2 => getFirstChild( locNode )
|
|
nb = 0
|
|
DO
|
|
IF ( .NOT. ASSOCIATED(locNode2) ) EXIT
|
|
IF ( getNodeType( locNode2 ) == ELEMENT_NODE ) THEN
|
|
IF ( INDEX(getTagName(locNode2), 'PP_GIPAW_CORE_ORBITAL' ) > 0) THEN
|
|
nb = nb + 1
|
|
CALL extractDataContent(locNode2, upf%gipaw_core_orbital(:,nb) )
|
|
CALL extractDataAttribute(locNode2, 'label', upf%gipaw_core_orbital_el(nb))
|
|
CALL extractDataAttribute(locNode2, 'n', upf%gipaw_core_orbital_n(nb))
|
|
CALL extractDataAttribute(locNode2, 'l', upf%gipaw_core_orbital_l(nb))
|
|
END IF
|
|
END IF
|
|
locNode3 => locNode2
|
|
locNode2 => getNextSibling(locNode3)
|
|
ENDDO
|
|
!
|
|
! Read valence all-electron and pseudo orbitals and their labels
|
|
!
|
|
IF (upf%paw_as_gipaw) THEN
|
|
!READ PAW DATA INSTEAD OF GIPAW
|
|
upf%gipaw_wfs_nchannels = upf%nbeta
|
|
ALLOCATE ( upf%gipaw_wfs_el(upf%gipaw_wfs_nchannels) )
|
|
ALLOCATE ( upf%gipaw_wfs_ll(upf%gipaw_wfs_nchannels) )
|
|
ALLOCATE ( upf%gipaw_wfs_rcut(upf%gipaw_wfs_nchannels) )
|
|
ALLOCATE ( upf%gipaw_wfs_rcutus(upf%gipaw_wfs_nchannels) )
|
|
ALLOCATE ( upf%gipaw_wfs_ae(upf%mesh,upf%gipaw_wfs_nchannels) )
|
|
ALLOCATE ( upf%gipaw_wfs_ps(upf%mesh,upf%gipaw_wfs_nchannels) )
|
|
DO nb = 1,upf%gipaw_wfs_nchannels
|
|
upf%gipaw_wfs_el(nb) = upf%els_beta(nb)
|
|
upf%gipaw_wfs_ll(nb) = upf%lll(nb)
|
|
upf%gipaw_wfs_ae(:,nb) = upf%aewfc(:,nb)
|
|
ENDDO
|
|
DO nb = 1,upf%gipaw_wfs_nchannels
|
|
upf%gipaw_wfs_ps(:,nb) = upf%pswfc(:,nb)
|
|
ENDDO
|
|
ALLOCATE ( upf%gipaw_vlocal_ae(upf%mesh) )
|
|
ALLOCATE ( upf%gipaw_vlocal_ps(upf%mesh) )
|
|
upf%gipaw_vlocal_ae(:)= upf%paw%ae_vloc(:)
|
|
upf%gipaw_vlocal_ps(:)= upf%vloc(:)
|
|
DO nb = 1,upf%gipaw_wfs_nchannels
|
|
upf%gipaw_wfs_rcut(nb)=upf%rcut(nb)
|
|
upf%gipaw_wfs_rcutus(nb)=upf%rcutus(nb)
|
|
ENDDO
|
|
ELSEIF (upf%tcoulombp) THEN
|
|
upf%gipaw_wfs_nchannels = 1
|
|
ALLOCATE ( upf%gipaw_wfs_el(upf%gipaw_wfs_nchannels) )
|
|
ALLOCATE ( upf%gipaw_wfs_ll(upf%gipaw_wfs_nchannels) )
|
|
ALLOCATE ( upf%gipaw_wfs_rcut(upf%gipaw_wfs_nchannels) )
|
|
ALLOCATE ( upf%gipaw_wfs_rcutus(upf%gipaw_wfs_nchannels) )
|
|
ALLOCATE ( upf%gipaw_wfs_ae(upf%mesh,upf%gipaw_wfs_nchannels) )
|
|
ALLOCATE ( upf%gipaw_wfs_ps(upf%mesh,upf%gipaw_wfs_nchannels) )
|
|
DO nb = 1,upf%gipaw_wfs_nchannels
|
|
upf%gipaw_wfs_el(nb) = "1S"
|
|
upf%gipaw_wfs_ll(nb) = 0
|
|
upf%gipaw_wfs_ae(:,nb) = 0.0d0
|
|
upf%gipaw_wfs_ps(:,nb) = 0.0d0
|
|
ENDDO
|
|
ALLOCATE ( upf%gipaw_vlocal_ae(upf%mesh) )
|
|
ALLOCATE ( upf%gipaw_vlocal_ps(upf%mesh) )
|
|
upf%gipaw_vlocal_ae(:)= 0.0d0
|
|
upf%gipaw_vlocal_ps(:)= 0.0d0
|
|
DO nb = 1,upf%gipaw_wfs_nchannels
|
|
upf%gipaw_wfs_rcut(nb)=1.0d0
|
|
upf%gipaw_wfs_rcutus(nb)=1.0d0
|
|
ENDDO
|
|
ELSE
|
|
locNode => item(getElementsByTagname(gpawNode, 'PP_GIPAW_ORBITALS'), 0)
|
|
CALL extractDataAttribute(locNode, 'number_of_valence_orbitals', upf%gipaw_wfs_nchannels)
|
|
|
|
ALLOCATE ( upf%gipaw_wfs_el(upf%gipaw_wfs_nchannels) )
|
|
ALLOCATE ( upf%gipaw_wfs_ll(upf%gipaw_wfs_nchannels) )
|
|
ALLOCATE ( upf%gipaw_wfs_rcut(upf%gipaw_wfs_nchannels) )
|
|
ALLOCATE ( upf%gipaw_wfs_rcutus(upf%gipaw_wfs_nchannels) )
|
|
ALLOCATE ( upf%gipaw_wfs_ae(upf%mesh,upf%gipaw_wfs_nchannels) )
|
|
ALLOCATE ( upf%gipaw_wfs_ps(upf%mesh,upf%gipaw_wfs_nchannels) )
|
|
|
|
locNode2 => getFirstChild(locNode)
|
|
nb = 0
|
|
DO
|
|
IF (.NOT. ASSOCIATED( locNode2 )) EXIT
|
|
!
|
|
IF ( getNodeType( locNode2 ) == ELEMENT_NODE) THEN
|
|
IF ( index( getTagName( locNode2 ), "PP_GIPAW_ORBITAL." )> 0) THEN
|
|
nb = nb + 1
|
|
CALL extractDataAttribute(locNode2, 'label', upf%gipaw_wfs_el(nb))
|
|
CALL extractDataAttribute(locNode2, 'l', upf%gipaw_wfs_ll(nb))
|
|
CALL extractDataAttribute(locNode2, 'cutoff_radius', upf%gipaw_wfs_rcut(nb))
|
|
IF (hasAttribute(locNode, 'ultrasoft_cutoff_radius') ) THEN
|
|
CALL extractDataAttribute(locNode, 'ultrasoft_cutoff_radius', upf%gipaw_wfs_rcutus(nb) )
|
|
ELSE
|
|
upf%gipaw_wfs_rcutus(nb) = upf%gipaw_wfs_rcut(nb)
|
|
END IF
|
|
! read all-electron orbital
|
|
locNode4 => item( getElementsByTagname(locNode2, 'PP_GIPAW_WFS_AE'), 0)
|
|
CALL extractDataContent(locNode4, upf%gipaw_wfs_ae(:,nb))
|
|
! read pseudo orbital
|
|
locNode4 => item( getElementsByTagname( locNode2, 'PP_GIPAW_WFS_PS'), 0)
|
|
CALL extractDataContent(locNode4, upf%gipaw_wfs_ps(:,nb))
|
|
END IF
|
|
END IF
|
|
locNode3 => locNode2
|
|
locNode2 => getNextSibling(locNode3)
|
|
!
|
|
ENDDO
|
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
! Read all-electron and pseudo local potentials
|
|
ALLOCATE ( upf%gipaw_vlocal_ae(upf%mesh) )
|
|
ALLOCATE ( upf%gipaw_vlocal_ps(upf%mesh) )
|
|
locNode => item(getElementsByTagname( gpawNode, 'PP_GIPAW_VLOCAL'), 0)
|
|
!
|
|
locNode2 => item(getElementsBytagname( locNode, 'PP_GIPAW_VLOCAL_AE'), 0)
|
|
CALL extractDataContent (locNode2, upf%gipaw_vlocal_ae(:))
|
|
!
|
|
locNode2 => item(getElementsByTagname( locNode, 'PP_GIPAW_VLOCAL_PS'), 0)
|
|
CALL extractDataContent(locNode2, upf%gipaw_vlocal_ps(:))
|
|
ENDIF
|
|
RETURN
|
|
END SUBROUTINE read_upf_gipaw
|
|
!
|
|
|
|
!
|
|
END MODULE read_upf_v2_module
|