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(HubbardInterSpecieV_type),ALLOCATABLE :: Hub_V_(:)
LOGICAL :: noncolin_ =.FALSE.
INTEGER :: icheck
!
IF (PRESENT(n) .AND. PRESENT(l)) THEN
CALL set_labels (nsp, n, l)
@ -453,7 +454,11 @@ CONTAINS
IF ( PRESENT(noncolin)) noncolin_ = noncolin
!
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
IF (PRESENT(U)) CALL init_hubbard_commons(U, U_, label, "Hubbard_U")
END IF
@ -541,23 +546,28 @@ CONTAINS
END DO
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
TYPE(HubbardInterSpecieV_type), ALLOCATABLE :: objs(:)
REAL(DP) :: hubbard_v_(:,:,:)
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
!
nat_ = SIZE(ityp)
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
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
DO na =1, nat_
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))
END DO
END DO
END SUBROUTINE check_and_init_Hubbard_V
END FUNCTION check_and_init_Hubbard_V
SUBROUTINE reset_hubbard_commons(objs)