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