1! 2! Copyright (C) 2001-2018 Quantum ESPRESSO group 3! This file is distributed under the terms of the 4! GNU General Public License. See the file `License' 5! in the root directory of the present distribution, 6! or http://www.gnu.org/copyleft/gpl.txt . 7! 8! 9!----------------------------------------------------------------------- 10MODULE write_hub 11!----------------------------------------------------------------------- 12! 13CONTAINS 14! 15!----------------------------------------------------------------------- 16SUBROUTINE write_dnsscf_ph 17 !--------------------------------------------------------------------- 18 ! 19 ! DFPT+U: This routine transforms dnsscf_all_modes 20 ! (which is the response of occupation matrices due to 21 ! atomic displacements) from the pattern basis u to cartesian 22 ! coordinates and then writes it to the standard output. 23 ! 24 ! Written by A. Floris 25 ! Modified by I. Timrov (01.10.2018) 26 ! 27 USE kinds, ONLY : DP 28 USE io_global, ONLY : stdout 29 USE ions_base, ONLY : nat, ityp 30 USE ldaU, ONLY : lda_plus_u, Hubbard_lmax, Hubbard_l, is_hubbard 31 USE ldaU_ph, ONLY : dnsscf_all_modes 32 USE lsda_mod, ONLY : nspin 33 USE modes, ONLY : u, nmodes 34 ! 35 IMPLICIT none 36 ! 37 INTEGER :: na_icart, nah, is, m1, m2, na, icart, nt, & 38 nap_jcar, nap, na_icar, jcar, icar, nb, imode 39 COMPLEX(DP), ALLOCATABLE :: dnsscf_all_modes_cart(:,:,:,:,:) 40 ! 41 ALLOCATE (dnsscf_all_modes_cart(2*Hubbard_lmax+1,2*Hubbard_lmax+1,nspin,nat,nmodes)) 42 dnsscf_all_modes_cart = (0.d0, 0.d0) 43 ! 44 ! Transform dnsscf_all_modes from the pattern basis u to cartesian coordinates 45 ! 46 DO na_icart = 1, 3*nat 47 DO imode = 1, nmodes 48 DO nah = 1, nat 49 nt = ityp(nah) 50 IF (is_hubbard(nt)) THEN 51 DO is = 1, nspin 52 DO m1 = 1, 2 * Hubbard_l(nt) + 1 53 DO m2 = 1, 2 * Hubbard_l(nt) + 1 54 dnsscf_all_modes_cart(m1,m2,is,nah,na_icart) = & 55 dnsscf_all_modes_cart(m1,m2,is,nah,na_icart) + & 56 dnsscf_all_modes(m1,m2,is,nah,imode) * CONJG(u(na_icart,imode)) 57 ENDDO 58 ENDDO 59 ENDDO 60 ENDIF 61 ENDDO 62 ENDDO 63 ENDDO 64 ! 65 ! Write dnsscf_all_modes_cart to the standard output 66 ! 67 WRITE(stdout,*) 68 WRITE(stdout,*) 'DNS_SCF SYMMETRIZED IN CARTESIAN COORDINATES' 69 DO na = 1, nat 70 DO icart = 1, 3 71 WRITE(stdout,'(a,1x,i2,2x,a,1x,i2)') 'displaced atom L =', na, 'ipol=', icart 72 na_icart = 3 * (na - 1) + icart 73 DO nah = 1, nat 74 nt = ityp(nah) 75 IF (is_hubbard(nt)) THEN 76 DO is = 1, nspin 77 WRITE(stdout,'(a,1x,i2,2x,a,1x,i2)') ' Hubbard atom', nah, 'spin', is 78 DO m1 = 1, 2 * Hubbard_l(nt) + 1 79 WRITE( stdout,'(14(f15.10,1x))') dnsscf_all_modes_cart (m1,:,is,nah,na_icart) 80 ENDDO 81 ENDDO 82 ENDIF 83 ENDDO 84 ENDDO 85 ENDDO 86 WRITE(stdout,*) 87 ! 88 DEALLOCATE(dnsscf_all_modes_cart) 89 ! 90 RETURN 91 ! 92END SUBROUTINE write_dnsscf_ph 93!----------------------------------------------------------------------- 94 95!----------------------------------------------------------------------- 96SUBROUTINE write_dnsscf_e 97 !--------------------------------------------------------------------- 98 ! 99 ! DFPT+U: This routine transforms dnsscf_all_modes 100 ! (which is the response of occupation matrices due to 101 ! the electric field perturbation) from crystal to cartesian 102 ! coordinates and then writes it to the standard output. 103 ! 104 ! Written by A. Floris 105 ! Modified by I. Timrov (01.10.2018) 106 ! 107 USE kinds, ONLY : DP 108 USE io_global, ONLY : stdout 109 USE ions_base, ONLY : nat, ityp 110 USE ldaU, ONLY : lda_plus_u, Hubbard_lmax, Hubbard_l, is_hubbard 111 USE ldaU_ph, ONLY : dnsscf_all_modes 112 USE cell_base, ONLY : at 113 USE lsda_mod, ONLY : nspin 114 ! 115 IMPLICIT none 116 ! 117 INTEGER :: icart, ipol, nt, nah, m1, m2, is 118 COMPLEX(DP), ALLOCATABLE :: dnsscf_all_modes_cart(:,:,:,:,:) 119 ! 120 ALLOCATE (dnsscf_all_modes_cart(2*Hubbard_lmax+1,2*Hubbard_lmax+1,nspin,nat,3)) 121 dnsscf_all_modes_cart = (0.d0, 0.d0) 122 ! 123 ! Transform dnsscf_all_modes from crystal to cartesian coordinates 124 ! 125 DO icart = 1, 3 126 DO ipol = 1, 3 127 DO nah = 1, nat 128 nt = ityp(nah) 129 IF (is_hubbard(nt)) THEN 130 DO is = 1, nspin 131 DO m1 = 1, 2*Hubbard_l(nt)+1 132 DO m2 = 1, 2*Hubbard_l(nt)+1 133 dnsscf_all_modes_cart(m1,m2,is,nah,icart) = & 134 dnsscf_all_modes_cart(m1,m2,is,nah,icart) + & 135 dnsscf_all_modes(m1,m2,is,nah,ipol)* at(icart,ipol) 136 ENDDO 137 ENDDO 138 ENDDO 139 ENDIF 140 ENDDO 141 ENDDO 142 ENDDO 143 ! 144 ! Write dnsscf_all_modes_cart to the standard output 145 ! 146 WRITE(stdout,*) 147 WRITE(stdout,*) 'DNS_SCF SYMMETRIZED IN ELECTRIC FIELD IN CARTESIAN COORDINATES' 148 DO icart = 1, 3 149 WRITE(stdout,'(a,1x,i2)') 'icart=', icart 150 DO nah = 1, nat 151 nt = ityp(nah) 152 IF (is_hubbard(nt)) THEN 153 DO is = 1, nspin 154 WRITE(stdout,'(a,1x,i2,2x,a,1x,i2)') ' Hubbard atom', nah, 'spin', is 155 DO m1 = 1, 2*Hubbard_l(nt)+1 156 WRITE(stdout,'(14(f15.10,1x))') dnsscf_all_modes_cart (m1,:,is,nah,icart) 157 ENDDO 158 ENDDO 159 ENDIF 160 ENDDO 161 ENDDO 162 WRITE(stdout,*) 163 ! 164 DEALLOCATE(dnsscf_all_modes_cart) 165 ! 166 RETURN 167 ! 168END SUBROUTINE write_dnsscf_e 169!------------------------------------------------------------------------------------------- 170 171!----------------------------------------------------------------------- 172SUBROUTINE write_dynmat_hub 173 !--------------------------------------------------------------------- 174 ! 175 ! DFPT+U: This routine writes the scf and total hubbard dynamical 176 ! matrix to the standard output. 177 ! 178 ! Written by A. Floris 179 ! Modified by I. Timrov (01.10.2018) 180 ! 181 USE kinds, ONLY : DP 182 USE io_global, ONLY : stdout, ionode 183 USE dynmat, ONLY : dyn_hub_scf, dyn_hub_bare 184 USE ldaU_ph, ONLY : dnsscf_all_modes 185 USE ldaU, ONLY : lda_plus_u, Hubbard_lmax, Hubbard_l, is_hubbard 186 USE control_flags, ONLY : iverbosity 187 USE lsda_mod, ONLY : nspin 188 USE ions_base, ONLY : nat, ityp 189 USE modes, ONLY : u, nmodes 190 ! 191 IMPLICIT NONE 192 ! 193 COMPLEX(DP), ALLOCATABLE :: dyn_hub_tot(:,:) 194 ! 195 ALLOCATE(dyn_hub_tot(3*nat,3*nat)) 196 dyn_hub_tot = (0.d0, 0.d0) 197 ! 198 ! Write the UNSYMMETRIZED SCF Hubbard dynamical matrix 199 ! in the pattern basis 200 ! 201 CALL tra_write_matrix_no_sym ('dyn_hub_scf NOT SYMMETRIZED',dyn_hub_scf,nat) 202 ! 203 ! Write the SYMMETRIZED SCF Hubbard dynamical matrix 204 ! in carthesian coordinates 205 ! 206 CALL tra_write_matrix ('dyn_hub_scf SYMMETRIZED',dyn_hub_scf,u,nat) 207 ! 208 ! The total Hubbard dynamical matrix 209 ! 210 IF (ALLOCATED(dyn_hub_bare)) THEN 211 dyn_hub_tot = dyn_hub_scf + dyn_hub_bare 212 ELSE 213 WRITE(stdout,'("Warning! dyn_hub_bare is not allocated.")') 214 ENDIF 215 ! 216 ! Write the UNSYMMETRIZED total Hubbard dynamical matrix 217 ! in the pattern basis 218 ! 219 CALL tra_write_matrix_no_sym('dyn_hub_tot NOT SYMMETRIZED',dyn_hub_tot,nat) 220 ! 221 ! Write the SYMMETRIZED total Hubbard dynamical matrix 222 ! in carthesian coordinates 223 ! 224 CALL tra_write_matrix('dyn_hub_tot SYMMETRIZED',dyn_hub_tot,u,nat) 225 ! 226 DEALLOCATE (dyn_hub_tot) 227 ! 228 RETURN 229 ! 230END SUBROUTINE write_dynmat_hub 231!--------------------------------------------------------------------------- 232 233END MODULE write_hub 234!----------------------------------------------------------------------- 235