Spin-orbit case for v.2 UPF fixed (maybe)

This commit is contained in:
Paolo Giannozzi 2020-06-10 10:07:05 +02:00
parent 7eb44391b7
commit f0ebe9549a
2 changed files with 77 additions and 2 deletions

View File

@ -99,6 +99,8 @@ CONTAINS
CALL xmlr_readtag( capitalize_if_v2('pp_rhoatom'), &
upf%rho_at(1:upf%mesh) )
!
CALL read_pp_spinorb ( upf )
!
CALL read_pp_paw ( upf )
!
CALL read_pp_gipaw ( upf )
@ -319,13 +321,14 @@ CONTAINS
ALLOCATE (upf%beta(upf%mesh,nb) )
ALLOCATE (upf%els_beta(nb), &
upf%lll(nb), &
upf%jjj(nb), &
upf%kbeta(nb), &
upf%rcut(nb), &
upf%rcutus(nb), &
upf%dion(nb,nb), &
upf%qqq(nb,nb) )
!
IF (upf%has_so) ALLOCATE( upf%jjj(upf%nbeta))
!
IF ( upf%nbeta == 0 ) THEN
upf%nqf = 0
upf%nqlc= 0
@ -501,6 +504,10 @@ CONTAINS
upf%rcut_chi(upf%nwfc), &
upf%rcutus_chi(upf%nwfc), &
upf%epseu(upf%nwfc) )
IF ( upf%has_so ) THEN
allocate ( upf%nn(upf%nwfc) )
allocate ( upf%jchi(upf%nwfc) )
END IF
!
CALL xmlr_opentag( capitalize_if_v2('pp_pswfc') )
DO nw=1,upf%nwfc
@ -515,7 +522,7 @@ CONTAINS
call upf_error('read_pp_pswfc','mismatch reading PSWFC', nw)
call get_attr( 'label', upf%els(nw) )
call get_attr( 'l', upf%lchi(nw) )
IF ( upf%has_so) THEN
IF ( .not. v2 .and. upf%has_so ) THEN
call get_attr( 'nn', upf%nn(nw) )
call get_attr( 'jchi', upf%jchi(nw) )
END IF
@ -588,6 +595,40 @@ CONTAINS
END SUBROUTINE read_pp_full_wfc
!
!--------------------------------------------------------
SUBROUTINE read_pp_spinorb ( upf )
!--------------------------------------------------------
!
IMPLICIT NONE
TYPE(pseudo_upf),INTENT(INOUT) :: upf ! the pseudo data
INTEGER :: nw, nb
CHARACTER(LEN=1) :: dummy
!
IF ( .NOT. v2 .OR. .NOT. upf%has_so ) RETURN
!
CALL xmlr_opentag( 'PP_SPIN_ORB' )
DO nw = 1,upf%nwfc
CALL xmlr_readtag( 'PP_RELWFC.'//i2c(nw), dummy )
CALL get_attr( 'index' , nb )
IF ( nb /= nw ) CALL upf_error('read_pp_spinorb','mismatch',1)
CALL get_attr( 'els', upf%els(nw) )
CALL get_attr( 'nn', upf%nn(nw) )
CALL get_attr( 'lchi', upf%lchi(nw) )
CALL get_attr( 'jchi', upf%jchi(nw) )
CALL get_attr( 'oc', upf%oc(nw) )
ENDDO
!
DO nb = 1,upf%nbeta
CALL xmlr_readtag( 'PP_RELBETA.'//i2c(nb), dummy )
CALL get_attr( 'index' , nw )
IF ( nb /= nw ) CALL upf_error('read_pp_spinorb','mismatch',2)
CALL get_attr( 'lll', upf%lll(nb) )
CALL get_attr( 'jjj', upf%jjj(nb) )
ENDDO
CALL xmlr_closetag () ! end pp_spin_orb
!
END SUBROUTINE read_pp_spinorb
!
!--------------------------------------------------------
SUBROUTINE read_pp_paw ( upf )
!--------------------------------------------------------
!

View File

@ -121,6 +121,8 @@ CONTAINS
CALL add_attr( 'size', upf%mesh )
CALL xmlw_writetag( capitalize_if_v2('pp_rhoatom'), upf%rho_at(1:upf%mesh))
!
CALL write_pp_spinorb ( upf )
!
CALL write_pp_paw ( upf )
!
CALL write_pp_gipaw ( upf )
@ -740,6 +742,38 @@ CONTAINS
END IF
!
END SUBROUTINE write_pp_full_wfc
!
!--------------------------------------------------------
SUBROUTINE write_pp_spinorb ( upf )
!--------------------------------------------------------
!
IMPLICIT NONE
TYPE(pseudo_upf),INTENT(IN) :: upf ! the pseudo data
INTEGER :: nw, nb
!
IF ( .NOT. v2 .OR. .NOT. upf%has_so ) RETURN
!
CALL xmlw_opentag( 'PP_SPIN_ORB' )
DO nw = 1,upf%nwfc
CALL add_attr( 'index' , nw )
CALL add_attr( 'els', upf%els(nw) )
CALL add_attr( 'nn', upf%nn(nw) )
CALL add_attr( 'lchi', upf%lchi(nw) )
CALL add_attr( 'jchi', upf%jchi(nw) )
CALL add_attr( 'oc', upf%oc(nw) )
CALL xmlw_writetag( 'PP_RELWFC.'//i2c(nw), '' )
ENDDO
!
DO nb = 1,upf%nbeta
CALL add_attr( 'index' , nb )
CALL add_attr( 'lll', upf%lll(nb) )
CALL add_attr( 'jjj', upf%jjj(nb) )
CALL xmlw_writetag( 'PP_RELBETA.'//i2c(nb), '' )
ENDDO
CALL xmlw_closetag () ! end pp_spin_orb
!
END SUBROUTINE write_pp_spinorb
!
!--------------------------------------------------------
SUBROUTINE write_pp_paw ( upf )
!--------------------------------------------------------