mirror of https://gitlab.com/QEF/q-e.git
233 lines
7.7 KiB
Fortran
233 lines
7.7 KiB
Fortran
!
|
|
! Copyright (C) 2001-2018 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 write_hub
|
|
!-----------------------------------------------------------------------
|
|
!! Routines for Hubbard related output.
|
|
!
|
|
CONTAINS
|
|
!
|
|
!-----------------------------------------------------------------------
|
|
SUBROUTINE write_dnsscf_ph
|
|
!---------------------------------------------------------------------
|
|
!! DFPT+U: This routine transforms \(\text{dnsscf_all_modes}\)
|
|
!! (which is the response of occupation matrices due to
|
|
!! atomic displacements) from the pattern basis \(\text{u}\) to
|
|
!! cartesian coordinates and then writes it to the standard output.
|
|
!
|
|
!! Written by A. Floris
|
|
!! Modified by I. Timrov (01.10.2018)
|
|
!
|
|
USE kinds, ONLY : DP
|
|
USE io_global, ONLY : stdout
|
|
USE ions_base, ONLY : nat, ityp
|
|
USE ldaU, ONLY : lda_plus_u, Hubbard_lmax, Hubbard_l, is_hubbard
|
|
USE ldaU_ph, ONLY : dnsscf_all_modes
|
|
USE lsda_mod, ONLY : nspin
|
|
USE modes, ONLY : u, nmodes
|
|
!
|
|
IMPLICIT none
|
|
!
|
|
INTEGER :: na_icart, nah, is, m1, m2, na, icart, nt, &
|
|
nap_jcar, nap, na_icar, jcar, icar, nb, imode
|
|
COMPLEX(DP), ALLOCATABLE :: dnsscf_all_modes_cart(:,:,:,:,:)
|
|
!
|
|
ALLOCATE (dnsscf_all_modes_cart(2*Hubbard_lmax+1,2*Hubbard_lmax+1,nspin,nat,nmodes))
|
|
dnsscf_all_modes_cart = (0.d0, 0.d0)
|
|
!
|
|
! Transform dnsscf_all_modes from the pattern basis u to cartesian coordinates
|
|
!
|
|
DO na_icart = 1, 3*nat
|
|
DO imode = 1, nmodes
|
|
DO nah = 1, nat
|
|
nt = ityp(nah)
|
|
IF (is_hubbard(nt)) THEN
|
|
DO is = 1, nspin
|
|
DO m1 = 1, 2 * Hubbard_l(nt) + 1
|
|
DO m2 = 1, 2 * Hubbard_l(nt) + 1
|
|
dnsscf_all_modes_cart(m1,m2,is,nah,na_icart) = &
|
|
dnsscf_all_modes_cart(m1,m2,is,nah,na_icart) + &
|
|
dnsscf_all_modes(m1,m2,is,nah,imode) * CONJG(u(na_icart,imode))
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO
|
|
ENDIF
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO
|
|
!
|
|
! Write dnsscf_all_modes_cart to the standard output
|
|
!
|
|
WRITE(stdout,*)
|
|
WRITE(stdout,*) 'DNS_SCF SYMMETRIZED IN CARTESIAN COORDINATES'
|
|
DO na = 1, nat
|
|
DO icart = 1, 3
|
|
WRITE(stdout,'(a,1x,i2,2x,a,1x,i2)') 'displaced atom L =', na, 'ipol=', icart
|
|
na_icart = 3 * (na - 1) + icart
|
|
DO nah = 1, nat
|
|
nt = ityp(nah)
|
|
IF (is_hubbard(nt)) THEN
|
|
DO is = 1, nspin
|
|
WRITE(stdout,'(a,1x,i2,2x,a,1x,i2)') ' Hubbard atom', nah, 'spin', is
|
|
DO m1 = 1, 2 * Hubbard_l(nt) + 1
|
|
WRITE( stdout,'(14(f15.10,1x))') dnsscf_all_modes_cart (m1,:,is,nah,na_icart)
|
|
ENDDO
|
|
ENDDO
|
|
ENDIF
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO
|
|
WRITE(stdout,*)
|
|
!
|
|
DEALLOCATE(dnsscf_all_modes_cart)
|
|
!
|
|
RETURN
|
|
!
|
|
END SUBROUTINE write_dnsscf_ph
|
|
!-----------------------------------------------------------------------
|
|
|
|
!-----------------------------------------------------------------------
|
|
SUBROUTINE write_dnsscf_e
|
|
!---------------------------------------------------------------------
|
|
!! DFPT+U: This routine transforms \(\text{dnsscf_all_modes}\)
|
|
!! (which is the response of occupation matrices due to
|
|
!! the electric field perturbation) from crystal to cartesian
|
|
!! coordinates and then writes it to the standard output.
|
|
!
|
|
!! Written by A. Floris.
|
|
!! Modified by I. Timrov (01.10.2018).
|
|
!
|
|
USE kinds, ONLY : DP
|
|
USE io_global, ONLY : stdout
|
|
USE ions_base, ONLY : nat, ityp
|
|
USE ldaU, ONLY : lda_plus_u, Hubbard_lmax, Hubbard_l, is_hubbard
|
|
USE ldaU_ph, ONLY : dnsscf_all_modes
|
|
USE cell_base, ONLY : at
|
|
USE lsda_mod, ONLY : nspin
|
|
!
|
|
IMPLICIT none
|
|
!
|
|
INTEGER :: icart, ipol, nt, nah, m1, m2, is
|
|
COMPLEX(DP), ALLOCATABLE :: dnsscf_all_modes_cart(:,:,:,:,:)
|
|
!
|
|
ALLOCATE (dnsscf_all_modes_cart(2*Hubbard_lmax+1,2*Hubbard_lmax+1,nspin,nat,3))
|
|
dnsscf_all_modes_cart = (0.d0, 0.d0)
|
|
!
|
|
! Transform dnsscf_all_modes from crystal to cartesian coordinates
|
|
!
|
|
DO icart = 1, 3
|
|
DO ipol = 1, 3
|
|
DO nah = 1, nat
|
|
nt = ityp(nah)
|
|
IF (is_hubbard(nt)) THEN
|
|
DO is = 1, nspin
|
|
DO m1 = 1, 2*Hubbard_l(nt)+1
|
|
DO m2 = 1, 2*Hubbard_l(nt)+1
|
|
dnsscf_all_modes_cart(m1,m2,is,nah,icart) = &
|
|
dnsscf_all_modes_cart(m1,m2,is,nah,icart) + &
|
|
dnsscf_all_modes(m1,m2,is,nah,ipol)* at(icart,ipol)
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO
|
|
ENDIF
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO
|
|
!
|
|
! Write dnsscf_all_modes_cart to the standard output
|
|
!
|
|
WRITE(stdout,*)
|
|
WRITE(stdout,*) 'DNS_SCF SYMMETRIZED IN ELECTRIC FIELD IN CARTESIAN COORDINATES'
|
|
DO icart = 1, 3
|
|
WRITE(stdout,'(a,1x,i2)') 'icart=', icart
|
|
DO nah = 1, nat
|
|
nt = ityp(nah)
|
|
IF (is_hubbard(nt)) THEN
|
|
DO is = 1, nspin
|
|
WRITE(stdout,'(a,1x,i2,2x,a,1x,i2)') ' Hubbard atom', nah, 'spin', is
|
|
DO m1 = 1, 2*Hubbard_l(nt)+1
|
|
WRITE(stdout,'(14(f15.10,1x))') dnsscf_all_modes_cart (m1,:,is,nah,icart)
|
|
ENDDO
|
|
ENDDO
|
|
ENDIF
|
|
ENDDO
|
|
ENDDO
|
|
WRITE(stdout,*)
|
|
!
|
|
DEALLOCATE(dnsscf_all_modes_cart)
|
|
!
|
|
RETURN
|
|
!
|
|
END SUBROUTINE write_dnsscf_e
|
|
!-------------------------------------------------------------------------------------------
|
|
|
|
!-----------------------------------------------------------------------
|
|
SUBROUTINE write_dynmat_hub
|
|
!---------------------------------------------------------------------
|
|
!! DFPT+U: This routine writes the scf and total Hubbard dynamical
|
|
!! matrix to the standard output.
|
|
!
|
|
!! Written by A. Floris.
|
|
!! Modified by I. Timrov (01.10.2018)
|
|
!
|
|
USE kinds, ONLY : DP
|
|
USE io_global, ONLY : stdout, ionode
|
|
USE dynmat, ONLY : dyn_hub_scf, dyn_hub_bare
|
|
USE ldaU_ph, ONLY : dnsscf_all_modes
|
|
USE ldaU, ONLY : lda_plus_u, Hubbard_lmax, Hubbard_l, is_hubbard
|
|
USE control_flags, ONLY : iverbosity
|
|
USE lsda_mod, ONLY : nspin
|
|
USE ions_base, ONLY : nat, ityp
|
|
USE modes, ONLY : u, nmodes
|
|
!
|
|
IMPLICIT NONE
|
|
!
|
|
COMPLEX(DP), ALLOCATABLE :: dyn_hub_tot(:,:)
|
|
!
|
|
ALLOCATE(dyn_hub_tot(3*nat,3*nat))
|
|
dyn_hub_tot = (0.d0, 0.d0)
|
|
!
|
|
! Write the UNSYMMETRIZED SCF Hubbard dynamical matrix
|
|
! in the pattern basis
|
|
!
|
|
CALL tra_write_matrix_no_sym ('dyn_hub_scf NOT SYMMETRIZED',dyn_hub_scf,nat)
|
|
!
|
|
! Write the SYMMETRIZED SCF Hubbard dynamical matrix
|
|
! in carthesian coordinates
|
|
!
|
|
CALL tra_write_matrix ('dyn_hub_scf SYMMETRIZED',dyn_hub_scf,u,nat)
|
|
!
|
|
! The total Hubbard dynamical matrix
|
|
!
|
|
IF (ALLOCATED(dyn_hub_bare)) THEN
|
|
dyn_hub_tot = dyn_hub_scf + dyn_hub_bare
|
|
ELSE
|
|
WRITE(stdout,'("Warning! dyn_hub_bare is not allocated.")')
|
|
ENDIF
|
|
!
|
|
! Write the UNSYMMETRIZED total Hubbard dynamical matrix
|
|
! in the pattern basis
|
|
!
|
|
CALL tra_write_matrix_no_sym('dyn_hub_tot NOT SYMMETRIZED',dyn_hub_tot,nat)
|
|
!
|
|
! Write the SYMMETRIZED total Hubbard dynamical matrix
|
|
! in carthesian coordinates
|
|
!
|
|
CALL tra_write_matrix('dyn_hub_tot SYMMETRIZED',dyn_hub_tot,u,nat)
|
|
!
|
|
DEALLOCATE (dyn_hub_tot)
|
|
!
|
|
RETURN
|
|
!
|
|
END SUBROUTINE write_dynmat_hub
|
|
!---------------------------------------------------------------------------
|
|
|
|
END MODULE write_hub
|
|
!-----------------------------------------------------------------------
|