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

disable dftU ouput XML element for U+V+back case 

the printout is not yet implement for this case, and was causing
an internal error.
thanks to @ye-luo
This commit is contained in:
Pietro Delugas 2022-06-03 16:13:01 +02:00
parent accec34683
commit 9b90c946e0
1 changed files with 17 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
Modules/qexsd_init.f90
View File

@ -443,6 +443,7 @@ CONTAINS
TYPE(HubbardBack_type),ALLOCATABLE :: Hub_back_(:) TYPE(HubbardBack_type),ALLOCATABLE :: Hub_back_(:)
TYPE(HubbardInterSpecieV_type),ALLOCATABLE :: Hub_V_(:) TYPE(HubbardInterSpecieV_type),ALLOCATABLE :: Hub_V_(:)
LOGICAL :: noncolin_ =.FALSE. LOGICAL :: noncolin_ =.FALSE.
INTEGER :: icheck
! !
IF (PRESENT(n) .AND. PRESENT(l)) THEN IF (PRESENT(n) .AND. PRESENT(l)) THEN
CALL set_labels (nsp, n, l) CALL set_labels (nsp, n, l)
@ -453,7 +454,11 @@ CONTAINS
IF ( PRESENT(noncolin)) noncolin_ = noncolin IF ( PRESENT(noncolin)) noncolin_ = noncolin
! !
IF (lda_plus_u_kind == 2 ) THEN IF (lda_plus_u_kind == 2 ) THEN
IF (PRESENT(hubbard_v)) CALL check_and_init_Hubbard_V (hub_v_, hubbard_v, species, label) IF (PRESENT(hubbard_v)) icheck = check_and_init_Hubbard_V (hub_v_, hubbard_v, species, label)
IF ( icheck == 0) THEN
obj%lwrite = .FALSE.
RETURN
END IF
ELSE ELSE
IF (PRESENT(U)) CALL init_hubbard_commons(U, U_, label, "Hubbard_U") IF (PRESENT(U)) CALL init_hubbard_commons(U, U_, label, "Hubbard_U")
END IF END IF
@ -541,23 +546,28 @@ CONTAINS
END DO END DO
END SUBROUTINE init_hubbard_J END SUBROUTINE init_hubbard_J
! !
SUBROUTINE check_and_init_Hubbard_V (objs, hubbard_v_, specs, labs) FUNCTION check_and_init_Hubbard_V (objs, hubbard_v_, specs, labs) result( ndim )
IMPLICIT NONE IMPLICIT NONE
TYPE(HubbardInterSpecieV_type), ALLOCATABLE :: objs(:) TYPE(HubbardInterSpecieV_type), ALLOCATABLE :: objs(:)
REAL(DP) :: hubbard_v_(:,:,:) REAL(DP) :: hubbard_v_(:,:,:)
CHARACTER(len=*) :: labs(:), specs(:) CHARACTER(len=*) :: labs(:), specs(:)
INTEGER :: ndim
! !
INTEGER :: nat_, nbt_, ndim, na, nb, idim, nb2isp INTEGER :: nat_, nbt_, na, nb, idim, nb2isp
CHARACTER(LEN=4) :: lab1, spec1, lab2, spec2 CHARACTER(LEN=4) :: lab1, spec1, lab2, spec2
! !
nat_ = SIZE(ityp) nat_ = SIZE(ityp)
nbt_ = SIZE(hubbard_v_, 2) / SIZE( hubbard_v_, 1) * nat_ nbt_ = SIZE(hubbard_v_, 2) / SIZE( hubbard_v_, 1) * nat_
! !
ndim = COUNT( hubbard_v_ > 0._DP ) ndim = COUNT( hubbard_v_(:,:,1) > 0._DP )
IF ( COUNT(hubbard_v_(:,:,2:4) > 0._DP) > 0 ) THEN
CALL infomsg("qexsd_init:hubbard_v", &
"XML printout for hubbard_v with background channels is not implemented")
ndim = 0
END IF
IF (ndim == 0 ) RETURN IF (ndim == 0 ) RETURN
ALLOCATE (objs(ndim)) ALLOCATE (objs(ndim))
IF ( COUNT(hubbard_v_(:,:,2:4) > 0._DP) > 0 ) CALL infomsg("qexsd_init:hubbard_v", &
"XML printout for hubbard_v with background channels is not implemented")
idim = 0 idim = 0
DO na =1, nat_ DO na =1, nat_
spec1 = TRIM(species(ityp(na))) spec1 = TRIM(species(ityp(na)))
@ -571,7 +581,7 @@ CONTAINS
CALL qes_init(objs(idim), "Hubbard_V", spec1, na, lab1, spec2, nb, lab2, Hubbard_V_(na,nb,1)) CALL qes_init(objs(idim), "Hubbard_V", spec1, na, lab1, spec2, nb, lab2, Hubbard_V_(na,nb,1))
END DO END DO
END DO END DO
END SUBROUTINE check_and_init_Hubbard_V END FUNCTION check_and_init_Hubbard_V
SUBROUTINE reset_hubbard_commons(objs) SUBROUTINE reset_hubbard_commons(objs)