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

reading and writing background stuff

This commit is contained in:
Pietro Delugas 2020-04-21 17:25:29 +02:00
parent 39cd418181
commit 0e14e5413d
9 changed files with 291 additions and 159 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
Modules/qes_bcast_module.f90
View File

@ -48,7 +48,7 @@ MODULE qes_bcast_module
MODULE PROCEDURE qes_bcast_starting_ns
MODULE PROCEDURE qes_bcast_Hubbard_ns
MODULE PROCEDURE qes_bcast_HubbardBack
MODULE PROCEDURE qes_bcast_backrestr
MODULE PROCEDURE qes_bcast_backL
MODULE PROCEDURE qes_bcast_vdW
MODULE PROCEDURE qes_bcast_spin
MODULE PROCEDURE qes_bcast_bands
@ -794,6 +794,14 @@ MODULE qes_bcast_module
CALL mp_bcast(obj%U_projection_type_ispresent, ionode_id, comm)
IF (obj%U_projection_type_ispresent) &
CALL mp_bcast(obj%U_projection_type, ionode_id, comm)
CALL mp_bcast(obj%Hubbard_back_ispresent, ionode_id, comm)
IF (obj%Hubbard_back_ispresent) THEN
CALL mp_bcast(obj%ndim_Hubbard_back, ionode_id, comm)
IF (.NOT.ionode) ALLOCATE(obj%Hubbard_back(obj%ndim_Hubbard_back))
DO i=1, obj%ndim_Hubbard_back
CALL qes_bcast_HubbardBack(obj%Hubbard_back(i), ionode_id, comm)
ENDDO
ENDIF
CALL mp_bcast(obj%Hubbard_U_back_ispresent, ionode_id, comm)
IF (obj%Hubbard_U_back_ispresent) THEN
CALL mp_bcast(obj%ndim_Hubbard_U_back, ionode_id, comm)
@ -928,28 +936,30 @@ MODULE qes_bcast_module
!
CALL mp_bcast(obj%species, ionode_id, comm)
CALL mp_bcast(obj%background, ionode_id, comm)
CALL mp_bcast(obj%ndim_label, ionode_id, comm)
IF (.NOT.ionode) ALLOCATE(obj%label(obj%ndim_label))
DO i=1, obj%ndim_label
CALL qes_bcast_backrestr(obj%label(i), ionode_id, comm)
CALL mp_bcast(obj%ndim_l_number, ionode_id, comm)
IF (.NOT.ionode) ALLOCATE(obj%l_number(obj%ndim_l_number))
DO i=1, obj%ndim_l_number
CALL qes_bcast_backL(obj%l_number(i), ionode_id, comm)
ENDDO
!
END SUBROUTINE qes_bcast_HubbardBack
!
!
SUBROUTINE qes_bcast_backrestr(obj, ionode_id, comm )
SUBROUTINE qes_bcast_backL(obj, ionode_id, comm )
!
IMPLICIT NONE
!
TYPE(backrestr_type), INTENT(INOUT) :: obj
TYPE(backL_type), INTENT(INOUT) :: obj
INTEGER, INTENT(IN) :: ionode_id, comm
!
CALL mp_bcast(obj%tagname, ionode_id, comm)
CALL mp_bcast(obj%lwrite, ionode_id, comm)
CALL mp_bcast(obj%lread, ionode_id, comm)
!
CALL mp_bcast(obj%l_index, ionode_id, comm)
CALL mp_bcast(obj%backL, ionode_id, comm)
!
END SUBROUTINE qes_bcast_backrestr
END SUBROUTINE qes_bcast_backL
!
!
SUBROUTINE qes_bcast_vdW(obj, ionode_id, comm )

33
Modules/qes_init_module.f90
View File

@ -51,7 +51,7 @@ MODULE qes_init_module
MODULE PROCEDURE qes_init_starting_ns
MODULE PROCEDURE qes_init_Hubbard_ns
MODULE PROCEDURE qes_init_HubbardBack
MODULE PROCEDURE qes_init_backrestr
MODULE PROCEDURE qes_init_backL
MODULE PROCEDURE qes_init_vdW
MODULE PROCEDURE qes_init_spin
MODULE PROCEDURE qes_init_bands
@ -1035,7 +1035,7 @@ MODULE qes_init_module
!
SUBROUTINE qes_init_dftU(obj, tagname, lda_plus_u_kind, Hubbard_U, Hubbard_J0, Hubbard_alpha,&
Hubbard_beta, Hubbard_J, starting_ns, Hubbard_ns, U_projection_type,&
Hubbard_U_back, Hubbard_alpha_back, Hubbard_ns_nc)
Hubbard_back, Hubbard_U_back, Hubbard_alpha_back, Hubbard_ns_nc)
!
IMPLICIT NONE
!
@ -1050,6 +1050,7 @@ MODULE qes_init_module
TYPE(starting_ns_type),OPTIONAL,DIMENSION(:),INTENT(IN) :: starting_ns
TYPE(Hubbard_ns_type),OPTIONAL,DIMENSION(:),INTENT(IN) :: Hubbard_ns
CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: U_projection_type
TYPE(HubbardBack_type),OPTIONAL,DIMENSION(:),INTENT(IN) :: Hubbard_back
TYPE(HubbardCommon_type),OPTIONAL,DIMENSION(:),INTENT(IN) :: Hubbard_U_back
TYPE(HubbardCommon_type),OPTIONAL,DIMENSION(:),INTENT(IN) :: Hubbard_alpha_back
TYPE(Hubbard_ns_type),OPTIONAL,DIMENSION(:),INTENT(IN) :: Hubbard_ns_nc
@ -1126,6 +1127,14 @@ MODULE qes_init_module
ELSE
obj%U_projection_type_ispresent = .FALSE.
END IF
IF ( PRESENT(Hubbard_back)) THEN
obj%Hubbard_back_ispresent = .TRUE.
ALLOCATE(obj%Hubbard_back(SIZE(Hubbard_back)))
obj%ndim_Hubbard_back = SIZE(Hubbard_back)
obj%Hubbard_back = Hubbard_back
ELSE
obj%Hubbard_back_ispresent = .FALSE.
END IF
IF ( PRESENT(Hubbard_U_back)) THEN
obj%Hubbard_U_back_ispresent = .TRUE.
ALLOCATE(obj%Hubbard_U_back(SIZE(Hubbard_U_back)))
@ -1266,7 +1275,7 @@ MODULE qes_init_module
END SUBROUTINE qes_init_Hubbard_ns
!
!
SUBROUTINE qes_init_HubbardBack(obj, tagname, species, background, label)
SUBROUTINE qes_init_HubbardBack(obj, tagname, species, background, l_number)
!
IMPLICIT NONE
!
@ -1274,7 +1283,7 @@ MODULE qes_init_module
CHARACTER(LEN=*), INTENT(IN) :: tagname
CHARACTER(LEN=*), INTENT(IN) :: species
CHARACTER(LEN=*),INTENT(IN) :: background
TYPE(backrestr_type),DIMENSION(:),INTENT(IN) :: label
TYPE(backL_type),DIMENSION(:),INTENT(IN) :: l_number
!
obj%tagname = TRIM(tagname)
obj%lwrite = .TRUE.
@ -1282,26 +1291,30 @@ MODULE qes_init_module
obj%species = species
!
obj%background = background
ALLOCATE( obj%label(SIZE(label)))
obj%ndim_label = SIZE(label)
obj%label = label
ALLOCATE( obj%l_number(SIZE(l_number)))
obj%ndim_l_number = SIZE(l_number)
obj%l_number = l_number
!
END SUBROUTINE qes_init_HubbardBack
!
!
SUBROUTINE qes_init_backrestr(obj, tagname)
SUBROUTINE qes_init_backL(obj, tagname, l_index, backL)
!
IMPLICIT NONE
!
TYPE(backrestr_type), INTENT(OUT) :: obj
TYPE(backL_type), INTENT(OUT) :: obj
CHARACTER(LEN=*), INTENT(IN) :: tagname
INTEGER, INTENT(IN) :: l_index
INTEGER, INTENT(IN) :: backL
!
obj%tagname = TRIM(tagname)
obj%lwrite = .TRUE.
obj%lread = .TRUE.
obj%l_index = l_index
!
obj%backL = backL
!
END SUBROUTINE qes_init_backrestr
END SUBROUTINE qes_init_backL
!
!
SUBROUTINE qes_init_vdW(obj, tagname, vdw_corr, dftd3_version, dftd3_threebody, non_local_term,&

51
Modules/qes_read_module.f90
View File

@ -48,7 +48,7 @@ MODULE qes_read_module
MODULE PROCEDURE qes_read_starting_ns
MODULE PROCEDURE qes_read_Hubbard_ns
MODULE PROCEDURE qes_read_HubbardBack
MODULE PROCEDURE qes_read_backrestr
MODULE PROCEDURE qes_read_backL
MODULE PROCEDURE qes_read_vdW
MODULE PROCEDURE qes_read_spin
MODULE PROCEDURE qes_read_bands
@ -3464,6 +3464,22 @@ MODULE qes_read_module
obj%U_projection_type_ispresent = .FALSE.
END IF
!
tmp_node_list => getElementsByTagname(xml_node, "Hubbard_back")
tmp_node_list_size = getLength(tmp_node_list)
!
!
IF (tmp_node_list_size>0) THEN
obj%Hubbard_back_ispresent = .TRUE.
ELSE
obj%Hubbard_back_ispresent = .FALSE.
END IF
obj%ndim_Hubbard_back = tmp_node_list_size
ALLOCATE(obj%Hubbard_back(tmp_node_list_size))
DO index=1,tmp_node_list_size
tmp_node => item( tmp_node_list, index-1 )
CALL qes_read_HubbardBack(tmp_node, obj%Hubbard_back(index), ierr )
END DO
!
tmp_node_list => getElementsByTagname(xml_node, "Hubbard_U_back")
tmp_node_list_size = getLength(tmp_node_list)
!
@ -3850,23 +3866,23 @@ MODULE qes_read_module
END IF
END IF
!
tmp_node_list => getElementsByTagname(xml_node, "label")
tmp_node_list => getElementsByTagname(xml_node, "l_number")
tmp_node_list_size = getLength(tmp_node_list)
!
IF (tmp_node_list_size < 1) THEN
IF (PRESENT(ierr) ) THEN
CALL infomsg("qes_read:HubbardBackType","label: not enough elements")
CALL infomsg("qes_read:HubbardBackType","l_number: not enough elements")
ierr = ierr + 1
ELSE
CALL errore("qes_read:HubbardBackType","label: not enough elements",10)
CALL errore("qes_read:HubbardBackType","l_number: not enough elements",10)
END IF
END IF
!
obj%ndim_label = tmp_node_list_size
ALLOCATE(obj%label(tmp_node_list_size))
obj%ndim_l_number = tmp_node_list_size
ALLOCATE(obj%l_number(tmp_node_list_size))
DO index=1,tmp_node_list_size
tmp_node => item( tmp_node_list, index-1 )
CALL qes_read_backrestr(tmp_node, obj%label(index), ierr )
CALL qes_read_backL(tmp_node, obj%l_number(index), ierr )
END DO
!
!
@ -3875,12 +3891,12 @@ MODULE qes_read_module
END SUBROUTINE qes_read_HubbardBack
!
!
SUBROUTINE qes_read_backrestr(xml_node, obj, ierr )
SUBROUTINE qes_read_backL(xml_node, obj, ierr )
!
IMPLICIT NONE
!
TYPE(Node), INTENT(IN), POINTER :: xml_node
TYPE(backrestr_type), INTENT(OUT) :: obj
TYPE(backL_type), INTENT(OUT) :: obj
INTEGER, OPTIONAL, INTENT(INOUT) :: ierr
!
TYPE(Node), POINTER :: tmp_node
@ -3890,14 +3906,29 @@ MODULE qes_read_module
obj%tagname = getTagName(xml_node)
!
IF (hasAttribute(xml_node, "l_index")) THEN
CALL extractDataAttribute(xml_node, "l_index", obj%l_index)
ELSE
IF ( PRESENT(ierr) ) THEN
CALL infomsg ( "qes_read: backLType",&
"required attribute l_index not found" )
ierr = ierr + 1
ELSE
CALL errore ("qes_read: backLType",&
"required attribute l_index not found", 10 )
END IF
END IF
!
!
!
CALL extractDataContent(xml_node, obj%backL )
!
obj%lwrite = .TRUE.
!
END SUBROUTINE qes_read_backrestr
END SUBROUTINE qes_read_backL
!
!
SUBROUTINE qes_read_vdW(xml_node, obj, ierr )

28
Modules/qes_reset_module.f90
View File

@ -49,7 +49,7 @@ MODULE qes_reset_module
MODULE PROCEDURE qes_reset_starting_ns
MODULE PROCEDURE qes_reset_Hubbard_ns
MODULE PROCEDURE qes_reset_HubbardBack
MODULE PROCEDURE qes_reset_backrestr
MODULE PROCEDURE qes_reset_backL
MODULE PROCEDURE qes_reset_vdW
MODULE PROCEDURE qes_reset_spin
MODULE PROCEDURE qes_reset_bands
@ -664,6 +664,16 @@ MODULE qes_reset_module
obj%Hubbard_ns_ispresent = .FALSE.
ENDIF
obj%U_projection_type_ispresent = .FALSE.
IF (obj%Hubbard_back_ispresent) THEN
IF (ALLOCATED(obj%Hubbard_back)) THEN
DO i=1, SIZE(obj%Hubbard_back)
CALL qes_reset_HubbardBack(obj%Hubbard_back(i))
ENDDO
DEALLOCATE(obj%Hubbard_back)
ENDIF
obj%ndim_Hubbard_back = 0
obj%Hubbard_back_ispresent = .FALSE.
ENDIF
IF (obj%Hubbard_U_back_ispresent) THEN
IF (ALLOCATED(obj%Hubbard_U_back)) THEN
DO i=1, SIZE(obj%Hubbard_U_back)
@ -773,28 +783,28 @@ MODULE qes_reset_module
obj%lwrite = .FALSE.
obj%lread = .FALSE.
!
IF (ALLOCATED(obj%label)) THEN
DO i=1, SIZE(obj%label)
CALL qes_reset_backrestr(obj%label(i))
IF (ALLOCATED(obj%l_number)) THEN
DO i=1, SIZE(obj%l_number)
CALL qes_reset_backL(obj%l_number(i))
ENDDO
DEALLOCATE(obj%label)
DEALLOCATE(obj%l_number)
ENDIF
obj%ndim_label = 0
obj%ndim_l_number = 0
!
END SUBROUTINE qes_reset_HubbardBack
!
!
SUBROUTINE qes_reset_backrestr(obj)
SUBROUTINE qes_reset_backL(obj)
!
IMPLICIT NONE
TYPE(backrestr_type),INTENT(INOUT) :: obj
TYPE(backL_type),INTENT(INOUT) :: obj
!
obj%tagname = ""
obj%lwrite = .FALSE.
obj%lread = .FALSE.
!
!
END SUBROUTINE qes_reset_backrestr
END SUBROUTINE qes_reset_backL
!
!
SUBROUTINE qes_reset_vdW(obj)

194
Modules/qes_types_module.f90
View File

@ -145,14 +145,17 @@ MODULE qes_types_module
!
END TYPE Hubbard_ns_type
!
TYPE :: backrestr_type
TYPE :: backL_type
!
CHARACTER(len=100) :: tagname
LOGICAL :: lwrite = .FALSE.
LOGICAL :: lread = .FALSE.
!
INTEGER :: l_index
!
END TYPE backrestr_type
INTEGER :: backL
!
END TYPE backL_type
!
TYPE :: smearing_type
!
@ -513,49 +516,6 @@ MODULE qes_types_module
!
END TYPE hybrid_type
!
TYPE :: dftU_type
!
CHARACTER(len=100) :: tagname
LOGICAL :: lwrite = .FALSE.
LOGICAL :: lread = .FALSE.
!
LOGICAL :: lda_plus_u_kind_ispresent = .FALSE.
INTEGER :: lda_plus_u_kind
LOGICAL :: Hubbard_U_ispresent = .FALSE.
TYPE(HubbardCommon_type), DIMENSION(:), ALLOCATABLE :: Hubbard_U
INTEGER :: ndim_Hubbard_U
LOGICAL :: Hubbard_J0_ispresent = .FALSE.
TYPE(HubbardCommon_type), DIMENSION(:), ALLOCATABLE :: Hubbard_J0
INTEGER :: ndim_Hubbard_J0
LOGICAL :: Hubbard_alpha_ispresent = .FALSE.
TYPE(HubbardCommon_type), DIMENSION(:), ALLOCATABLE :: Hubbard_alpha
INTEGER :: ndim_Hubbard_alpha
LOGICAL :: Hubbard_beta_ispresent = .FALSE.
TYPE(HubbardCommon_type), DIMENSION(:), ALLOCATABLE :: Hubbard_beta
INTEGER :: ndim_Hubbard_beta
LOGICAL :: Hubbard_J_ispresent = .FALSE.
TYPE(HubbardJ_type), DIMENSION(:), ALLOCATABLE :: Hubbard_J
INTEGER :: ndim_Hubbard_J
LOGICAL :: starting_ns_ispresent = .FALSE.
TYPE(starting_ns_type), DIMENSION(:), ALLOCATABLE :: starting_ns
INTEGER :: ndim_starting_ns
LOGICAL :: Hubbard_ns_ispresent = .FALSE.
TYPE(Hubbard_ns_type), DIMENSION(:), ALLOCATABLE :: Hubbard_ns
INTEGER :: ndim_Hubbard_ns
LOGICAL :: U_projection_type_ispresent = .FALSE.
CHARACTER(len=256) :: U_projection_type
LOGICAL :: Hubbard_U_back_ispresent = .FALSE.
TYPE(HubbardCommon_type), DIMENSION(:), ALLOCATABLE :: Hubbard_U_back
INTEGER :: ndim_Hubbard_U_back
LOGICAL :: Hubbard_alpha_back_ispresent = .FALSE.
TYPE(HubbardCommon_type), DIMENSION(:), ALLOCATABLE :: Hubbard_alpha_back
INTEGER :: ndim_Hubbard_alpha_back
LOGICAL :: Hubbard_ns_nc_ispresent = .FALSE.
TYPE(Hubbard_ns_type), DIMENSION(:), ALLOCATABLE :: Hubbard_ns_nc
INTEGER :: ndim_Hubbard_ns_nc
!
END TYPE dftU_type
!
TYPE :: HubbardBack_type
!
CHARACTER(len=100) :: tagname
@ -564,8 +524,8 @@ MODULE qes_types_module
!
CHARACTER(len=256) :: species
CHARACTER(len=256) :: background
TYPE(backrestr_type), DIMENSION(:), ALLOCATABLE :: label
INTEGER :: ndim_label
TYPE(backL_type), DIMENSION(:), ALLOCATABLE :: l_number
INTEGER :: ndim_l_number
!
END TYPE HubbardBack_type
!
@ -1105,21 +1065,51 @@ MODULE qes_types_module
!
END TYPE atomic_structure_type
!
TYPE :: dft_type
TYPE :: dftU_type
!
CHARACTER(len=100) :: tagname
LOGICAL :: lwrite = .FALSE.
LOGICAL :: lread = .FALSE.
!
CHARACTER(len=256) :: functional
LOGICAL :: hybrid_ispresent = .FALSE.
TYPE(hybrid_type) :: hybrid
LOGICAL :: dftU_ispresent = .FALSE.
TYPE(dftU_type) :: dftU
LOGICAL :: vdW_ispresent = .FALSE.
TYPE(vdW_type) :: vdW
LOGICAL :: lda_plus_u_kind_ispresent = .FALSE.
INTEGER :: lda_plus_u_kind
LOGICAL :: Hubbard_U_ispresent = .FALSE.
TYPE(HubbardCommon_type), DIMENSION(:), ALLOCATABLE :: Hubbard_U
INTEGER :: ndim_Hubbard_U
LOGICAL :: Hubbard_J0_ispresent = .FALSE.
TYPE(HubbardCommon_type), DIMENSION(:), ALLOCATABLE :: Hubbard_J0
INTEGER :: ndim_Hubbard_J0
LOGICAL :: Hubbard_alpha_ispresent = .FALSE.
TYPE(HubbardCommon_type), DIMENSION(:), ALLOCATABLE :: Hubbard_alpha
INTEGER :: ndim_Hubbard_alpha
LOGICAL :: Hubbard_beta_ispresent = .FALSE.
TYPE(HubbardCommon_type), DIMENSION(:), ALLOCATABLE :: Hubbard_beta
INTEGER :: ndim_Hubbard_beta
LOGICAL :: Hubbard_J_ispresent = .FALSE.
TYPE(HubbardJ_type), DIMENSION(:), ALLOCATABLE :: Hubbard_J
INTEGER :: ndim_Hubbard_J
LOGICAL :: starting_ns_ispresent = .FALSE.
TYPE(starting_ns_type), DIMENSION(:), ALLOCATABLE :: starting_ns
INTEGER :: ndim_starting_ns
LOGICAL :: Hubbard_ns_ispresent = .FALSE.
TYPE(Hubbard_ns_type), DIMENSION(:), ALLOCATABLE :: Hubbard_ns
INTEGER :: ndim_Hubbard_ns
LOGICAL :: U_projection_type_ispresent = .FALSE.
CHARACTER(len=256) :: U_projection_type
LOGICAL :: Hubbard_back_ispresent = .FALSE.
TYPE(HubbardBack_type), DIMENSION(:), ALLOCATABLE :: Hubbard_back
INTEGER :: ndim_Hubbard_back
LOGICAL :: Hubbard_U_back_ispresent = .FALSE.
TYPE(HubbardCommon_type), DIMENSION(:), ALLOCATABLE :: Hubbard_U_back
INTEGER :: ndim_Hubbard_U_back
LOGICAL :: Hubbard_alpha_back_ispresent = .FALSE.
TYPE(HubbardCommon_type), DIMENSION(:), ALLOCATABLE :: Hubbard_alpha_back
INTEGER :: ndim_Hubbard_alpha_back
LOGICAL :: Hubbard_ns_nc_ispresent = .FALSE.
TYPE(Hubbard_ns_type), DIMENSION(:), ALLOCATABLE :: Hubbard_ns_nc
INTEGER :: ndim_Hubbard_ns_nc
!
END TYPE dft_type
END TYPE dftU_type
!
TYPE :: basis_set_type
!
@ -1300,6 +1290,59 @@ MODULE qes_types_module
!
END TYPE band_structure_type
!
TYPE :: step_type
!
CHARACTER(len=100) :: tagname
LOGICAL :: lwrite = .FALSE.
LOGICAL :: lread = .FALSE.
!
INTEGER :: n_step
TYPE(scf_conv_type) :: scf_conv
TYPE(atomic_structure_type) :: atomic_structure
TYPE(total_energy_type) :: total_energy
TYPE(matrix_type) :: forces
LOGICAL :: stress_ispresent = .FALSE.
TYPE(matrix_type) :: stress
LOGICAL :: FCP_force_ispresent = .FALSE.
REAL(DP) :: FCP_force
LOGICAL :: FCP_tot_charge_ispresent = .FALSE.
REAL(DP) :: FCP_tot_charge
!
END TYPE step_type
!
TYPE :: dft_type
!
CHARACTER(len=100) :: tagname
LOGICAL :: lwrite = .FALSE.
LOGICAL :: lread = .FALSE.
!
CHARACTER(len=256) :: functional
LOGICAL :: hybrid_ispresent = .FALSE.
TYPE(hybrid_type) :: hybrid
LOGICAL :: dftU_ispresent = .FALSE.
TYPE(dftU_type) :: dftU
LOGICAL :: vdW_ispresent = .FALSE.
TYPE(vdW_type) :: vdW
!
END TYPE dft_type
!
TYPE :: outputElectricField_type
!
CHARACTER(len=100) :: tagname
LOGICAL :: lwrite = .FALSE.
LOGICAL :: lread = .FALSE.
!
LOGICAL :: BerryPhase_ispresent = .FALSE.
TYPE(BerryPhaseOutput_type) :: BerryPhase
LOGICAL :: finiteElectricFieldInfo_ispresent = .FALSE.
TYPE(finiteFieldOut_type) :: finiteElectricFieldInfo
LOGICAL :: dipoleInfo_ispresent = .FALSE.
TYPE(dipoleOutput_type) :: dipoleInfo
LOGICAL :: gateInfo_ispresent = .FALSE.
TYPE(gateInfo_type) :: gateInfo
!
END TYPE outputElectricField_type
!
TYPE :: input_type
!
CHARACTER(len=100) :: tagname
@ -1338,43 +1381,6 @@ MODULE qes_types_module
!
END TYPE input_type
!
TYPE :: step_type
!
CHARACTER(len=100) :: tagname
LOGICAL :: lwrite = .FALSE.
LOGICAL :: lread = .FALSE.
!
INTEGER :: n_step
TYPE(scf_conv_type) :: scf_conv
TYPE(atomic_structure_type) :: atomic_structure
TYPE(total_energy_type) :: total_energy
TYPE(matrix_type) :: forces
LOGICAL :: stress_ispresent = .FALSE.
TYPE(matrix_type) :: stress
LOGICAL :: FCP_force_ispresent = .FALSE.
REAL(DP) :: FCP_force
LOGICAL :: FCP_tot_charge_ispresent = .FALSE.
REAL(DP) :: FCP_tot_charge
!
END TYPE step_type
!
TYPE :: outputElectricField_type
!
CHARACTER(len=100) :: tagname
LOGICAL :: lwrite = .FALSE.
LOGICAL :: lread = .FALSE.
!
LOGICAL :: BerryPhase_ispresent = .FALSE.
TYPE(BerryPhaseOutput_type) :: BerryPhase
LOGICAL :: finiteElectricFieldInfo_ispresent = .FALSE.
TYPE(finiteFieldOut_type) :: finiteElectricFieldInfo
LOGICAL :: dipoleInfo_ispresent = .FALSE.
TYPE(dipoleOutput_type) :: dipoleInfo
LOGICAL :: gateInfo_ispresent = .FALSE.
TYPE(gateInfo_type) :: gateInfo
!
END TYPE outputElectricField_type
!
TYPE :: output_type
!
CHARACTER(len=100) :: tagname
@ -1438,4 +1444,4 @@ MODULE qes_types_module
END TYPE espresso_type
!
!
END MODULE qes_types_module
END MODULE qes_types_module

19
Modules/qes_write_module.f90
View File

@ -47,7 +47,7 @@ MODULE qes_write_module
MODULE PROCEDURE qes_write_starting_ns
MODULE PROCEDURE qes_write_Hubbard_ns
MODULE PROCEDURE qes_write_HubbardBack
MODULE PROCEDURE qes_write_backrestr
MODULE PROCEDURE qes_write_backL
MODULE PROCEDURE qes_write_vdW
MODULE PROCEDURE qes_write_spin
MODULE PROCEDURE qes_write_bands
@ -814,6 +814,11 @@ MODULE qes_write_module
CALL xml_addCharacters(xp, TRIM(obj%U_projection_type))
CALL xml_EndElement(xp, "U_projection_type")
END IF
IF (obj%Hubbard_back_ispresent) THEN
DO i = 1, obj%ndim_Hubbard_back
CALL qes_write_HubbardBack(xp, obj%Hubbard_back(i) )
END DO
END IF
IF (obj%Hubbard_U_back_ispresent) THEN
DO i = 1, obj%ndim_Hubbard_U_back
CALL qes_write_HubbardCommon(xp, obj%Hubbard_U_back(i) )
@ -930,25 +935,27 @@ MODULE qes_write_module
CALL xml_NewElement(xp, 'background')
CALL xml_addCharacters(xp, TRIM(obj%background))
CALL xml_EndElement(xp, 'background')
DO i = 1, obj%ndim_label
CALL qes_write_backrestr(xp, obj%label(i) )
DO i = 1, obj%ndim_l_number
CALL qes_write_backL(xp, obj%l_number(i) )
END DO
CALL xml_EndElement(xp, TRIM(obj%tagname))
END SUBROUTINE qes_write_HubbardBack
SUBROUTINE qes_write_backrestr(xp, obj)
SUBROUTINE qes_write_backL(xp, obj)
!-----------------------------------------------------------------
IMPLICIT NONE
TYPE (xmlf_t),INTENT(INOUT) :: xp
TYPE(backrestr_type),INTENT(IN) :: obj
TYPE(backL_type),INTENT(IN) :: obj
!
INTEGER :: i
!
IF ( .NOT. obj%lwrite ) RETURN
!
CALL xml_NewElement(xp, TRIM(obj%tagname))
CALL xml_addAttribute(xp, 'l_index', obj%l_index )
CALL xml_AddCharacters(xp, obj%backL)
CALL xml_EndElement(xp, TRIM(obj%tagname))
END SUBROUTINE qes_write_backrestr
END SUBROUTINE qes_write_backL
SUBROUTINE qes_write_vdW(xp, obj)
!-----------------------------------------------------------------

37
Modules/qexsd_copy.f90
View File

@ -310,7 +310,7 @@ CONTAINS
dft_name, nq1, nq2, nq3, ecutfock, exx_fraction, screening_parameter, &
exxdiv_treatment, x_gamma_extrapolation, ecutvcut, local_thr, &
lda_plus_U, lda_plus_U_kind, U_projection, Hubbard_l, Hubbard_lmax, &
Hubbard_l_back, backall, Hubbard_lmax_back, Hubbard_alpha_back, &
Hubbard_l_back, Hubbard_l1_back, backall, Hubbard_lmax_back, Hubbard_alpha_back, &
Hubbard_U, Hubbard_U_back, Hubbard_J0, Hubbard_alpha, Hubbard_beta, Hubbard_J, &
vdw_corr, scal6, lon_rcut, vdw_isolated )
!-------------------------------------------------------------------
@ -334,7 +334,7 @@ CONTAINS
LOGICAL, INTENT(out) :: lda_plus_U
INTEGER, INTENT(inout) :: lda_plus_U_kind, Hubbard_lmax, Hubbard_lmax_back
CHARACTER(LEN=*), INTENT(inout) :: U_projection
INTEGER, INTENT(inout) :: Hubbard_l(:), Hubbard_l_back(:)
INTEGER, INTENT(inout) :: Hubbard_l(:), Hubbard_l_back(:), Hubbard_l1_back(:)
REAL(dp), INTENT(inout) :: Hubbard_U(:), Hubbard_U_back(:), Hubbard_J0(:), Hubbard_J(:,:), &
Hubbard_alpha(:), Hubbard_alpha_back(:), Hubbard_beta(:)
LOGICAL, INTENT(inout) :: backall(:)
@ -406,24 +406,31 @@ CONTAINS
loop_on_speciesU_back:DO isp = 1, nsp
IF ( TRIM(symbol) == TRIM ( atm(isp) ) ) THEN
Hubbard_U_back(isp) = dft_obj%dftU%Hubbard_U_back(ihub)%HubbardCommon
SELECT CASE ( TRIM (label))
CASE ( '1s', '2s', '3s', '4s', '5s', '6s', '7s' )
Hubbard_l_back(isp) = 0
CASE ( '2p', '3p', '4p', '5p', '6p' )
Hubbard_l_back(isp) = 1
CASE ( '3d', '4d', '5d' )
Hubbard_l_back( isp ) = 2
CASE ( '4f', '5f' )
Hubbard_l_back(isp ) = 3
CASE default
IF (Hubbard_U_back(isp)/=0) &
CALL errore ("qexsd_copy_dft:", "unrecognized label for Hubbard back "//label, 1 )
END SELECT
EXIT loop_on_speciesU_back
END IF
END DO loop_on_speciesU_back
END DO loop_on_hubbardUback
IF (.NOT. dft_obj%dftU%Hubbard_back_ispresent) CALL errore("qexsd_copy:", &
"internal error: U_back is present but not Hub_back",1)
loop_hubbardBack: DO ihub =1, dft_obj%dftU%ndim_Hubbard_back
symbol = TRIM(dft_obj%dftU%Hubbard_back(ihub)%species)
loop_on_species_2:DO isp = 1, nsp
IF ( TRIM(symbol) == TRIM(atm(isp))) THEN
Hubbard_l_back(isp) = dft_obj%dftU%Hubbard_back(ihub)%l_number(1)%backL
SELECT CASE ( TRIM (dft_obj%dftU%Hubbard_back(ihub)%background))
CASE ('one_orbital')
backall(isp) = .FALSE.
CASE ('two_orbitals')
backall(isp) = .TRUE.
Hubbard_l1_back(isp) = dft_obj%dftU%Hubbard_back(ihub)%l_number(2)%backL
END SELECT
EXIT loop_on_species_2
END IF
END DO loop_on_species_2
END DO loop_hubbardBack
END IF
!
IF ( dft_obj%dftU%Hubbard_J0_ispresent ) THEN
loop_on_hubbardj0:DO ihub =1, dft_obj%dftU%ndim_Hubbard_J0

58
Modules/qexsd_init.f90
View File

@ -410,9 +410,10 @@ CONTAINS
!
END SUBROUTINE qexsd_init_hybrid
!
SUBROUTINE qexsd_init_dftU (obj, nsp, psd, species, ityp, is_hubbard, is_hubbard_back, noncolin, &
lda_plus_u_kind, U_projection_type, U, U_back, J0, J, &
alpha, beta, alpha_back, starting_ns, Hub_ns, Hub_ns_nc, backall)
SUBROUTINE qexsd_init_dftU (obj, nsp, psd, species, ityp, is_hubbard, &
is_hubbard_back, backall, hubb_l_back, hubb_l1_back, &
noncolin, lda_plus_u_kind, U_projection_type, U, U_back, J0, J, &
alpha, beta, alpha_back, starting_ns, Hub_ns, Hub_ns_nc )
IMPLICIT NONE
TYPE(dftU_type),INTENT(INOUT) :: obj
INTEGER,INTENT(IN) :: nsp
@ -421,12 +422,14 @@ CONTAINS
INTEGER,INTENT(IN) :: ityp(:)
LOGICAL,INTENT(IN) :: is_hubbard(nsp)
LOGICAL,OPTIONAL,INTENT(IN) :: is_hubbard_back(nsp)
LOGICAL,OPTIONAL,INTENT(IN) :: backall(nsp)
INTEGER,OPTIONAL,INTENT(IN) :: hubb_l_back(nsp)
INTEGER,OPTIONAL,INTENT(IN) :: hubb_l1_back(nsp)
INTEGER,INTENT(IN) :: lda_plus_u_kind
CHARACTER(LEN=*),INTENT(IN) :: U_projection_type
LOGICAL,OPTIONAL,INTENT(IN) :: noncolin
REAL(DP),OPTIONAL,INTENT(IN) :: U(:), U_back(:), J0(:), alpha(:), alpha_back(:), &
beta(:), J(:,:)
LOGICAL,OPTIONAL,INTENT(IN) :: backall(:)
REAL(DP),OPTIONAL,INTENT(IN) :: starting_ns(:,:,:), Hub_ns(:,:,:,:)
COMPLEX(DP),OPTIONAL,INTENT(IN) :: Hub_ns_nc(:,:,:,:)
!
@ -436,6 +439,7 @@ CONTAINS
TYPE(HubbardJ_type),ALLOCATABLE :: J_(:)
TYPE(starting_ns_type),ALLOCATABLE :: starting_ns_(:)
TYPE(Hubbard_ns_type),ALLOCATABLE :: Hubbard_ns_(:), Hubbard_ns_nc_(:)
TYPE(HubbardBack_type),ALLOCATABLE :: hub_back_(:)
LOGICAL :: noncolin_ =.FALSE.
!
CALL set_labels ()
@ -451,9 +455,11 @@ CONTAINS
IF (PRESENT(starting_ns)) CALL init_starting_ns(starting_ns_ , label)
IF (PRESENT(Hub_ns)) CALL init_Hubbard_ns(Hubbard_ns_ , label)
IF (PRESENT(Hub_ns_nc)) CALL init_Hubbard_ns(Hubbard_ns_nc_ , label)
IF (PRESENT(is_hubbard_back)) &
CALL init_Hubbard_back(is_hubbard_back, Hub_back_, hubb_l_back, backall, hubb_l1_back)
!
CALL qes_init (obj, "dftU", lda_plus_u_kind, U_, J0_, alpha_, beta_, J_, starting_ns_, Hubbard_ns_, &
U_projection_type, U_back_, alpha_back_, Hubbard_ns_nc_)
U_projection_type, Hub_back_, U_back_, alpha_back_, Hubbard_ns_nc_)
!
CALL reset_hubbard_commons(U_)
CALL reset_hubbard_commons(U_back_)
@ -630,6 +636,48 @@ CONTAINS
!
END SUBROUTINE init_Hubbard_ns
SUBROUTINE init_Hubbard_back(is_back, objs, l_back, backall_, l1_back)
IMPLICIT NONE
LOGICAL, INTENT(IN) :: is_back(nsp)
INTEGER, INTENT(IN) :: l_back(nsp)
TYPE(HubbardBack_type),ALLOCATABLE,INTENT(INOUT) :: objs(:)
LOGICAL,OPTIONAL,INTENT(IN) :: backall_(nsp)
INTEGER,OPTIONAL,INTENT(IN) :: l1_back(nsp)
!
INTEGER :: isp, il, ndimbackL
LOGICAL,ALLOCATABLE :: temp(:)
TYPE(backL_type) :: backL_objs(2)
CHARACTER(LEN=16) :: backchar
ALLOCATE(objs(nsp), temp(nsp))
IF (PRESENT(backall_)) THEN
temp(1:nsp) = backall_(1:nsp)
ELSE
temp(1:nsp) = .FALSE.
END IF
DO isp =1, nsp
CALL qes_init(backL_objs(1), "l_number", l_index=0, backL = l_back(nsp))
ndimbackL = 1
IF (temp(isp) .AND. PRESENT(l1_back) ) THEN
IF (l1_back(isp) >=0) THEN
ndimbackL=2
CALL qes_init(backL_objs(2), "l_number", l_index=1, backL = l1_back(nsp))
END IF
END IF
IF (temp(isp)) THEN
backchar = 'two_orbitals'
ELSE
backchar = 'one_orbital'
END IF
CALL qes_init(objs(isp), "Hubbard_back", SPECIES = TRIM(species(ityp(isp))), &
background=TRIM(backchar), l_number = backL_objs(1:ndimbackL))
IF (.NOT. is_back(isp)) objs(isp)%lwrite = .FALSE.
DO il = 1, ndimbackL
CALL qes_reset(backL_objs(il))
END DO
END DO
END SUBROUTINE init_Hubbard_back
SUBROUTINE reset_Hubbard_ns(objs)
IMPLICIT NONE
!

4
PW/src/pw_restart_new.f90
View File

@ -950,7 +950,7 @@ MODULE pw_restart_new
sname, inverse_s, s_axis_to_cart, &
time_reversal, no_t_rev, nosym, checkallsym
USE ldaU, ONLY : lda_plus_u, lda_plus_u_kind, Hubbard_lmax, Hubbard_lmax_back, &
Hubbard_l, Hubbard_l_back, backall, &
Hubbard_l, Hubbard_l_back, Hubbard_l1_back, backall, &
Hubbard_U, Hubbard_U_back, Hubbard_J, Hubbard_V, Hubbard_alpha, &
Hubbard_alpha_back, Hubbard_J0, Hubbard_beta, U_projection
USE funct, ONLY : set_exx_fraction, set_screening_parameter, &
@ -1054,7 +1054,7 @@ MODULE pw_restart_new
dft_name, nq1, nq2, nq3, ecutfock, exx_fraction, screening_parameter, &
exxdiv_treatment, x_gamma_extrapolation, ecutvcut, local_thr, &
lda_plus_U, lda_plus_U_kind, U_projection, Hubbard_l, Hubbard_lmax, &
Hubbard_l_back, backall, Hubbard_lmax_back, Hubbard_alpha_back, &
Hubbard_l_back, Hubbard_l1_back, backall, Hubbard_lmax_back, Hubbard_alpha_back, &
Hubbard_U, Hubbard_U_back, Hubbard_J0, Hubbard_alpha, Hubbard_beta, Hubbard_J, &
vdw_corr, scal6, lon_rcut, vdw_isolated )
!! More DFT initializations