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!---------------------------------------------------------------------
10SUBROUTINE sym_dns_wrapper (ldim, dns_cart, dns_pattern)
11  !-------------------------------------------------------------------
12  !
13  ! This routine symmetrizes dns_cart. This is done in three steps.
14  !
15  ! Written by I. Timrov using the code by S. de Gironcoli
16  ! and A. Floris (01.10.2018)
17  !
18  USE kinds,         ONLY : DP
19  USE ions_base,     ONLY : nat
20  USE modes,         ONLY : u, nmodes, nirr, npert
21  USE lsda_mod,      ONLY : nspin
22  !
23  IMPLICIT NONE
24  !
25  INTEGER, INTENT(IN) :: ldim
26  COMPLEX(DP), INTENT(INOUT) ::  dns_cart(ldim,ldim,nspin,nat,3,nat)
27  COMPLEX(DP), INTENT(OUT) :: dns_pattern(ldim,ldim,nspin,nat,3*nat)
28  ! in/out : dns_cart is the dns matrix in the cartesian coordinates;
29  !          on the input it is unsymmetrized, on the output it is symmetrized
30  ! out    : dns_pattern is the symmetrized dns matrix in the pattern basis
31  !
32  ! Local variables
33  !
34  INTEGER :: imode, imode0, na, icart, na_icart, irr, npe
35  COMPLEX(DP), ALLOCATABLE :: dns_aux(:,:,:,:,:)
36  !
37  dns_pattern = (0.d0, 0.d0)
38  !
39  ! 1 -  transform in the pattern basis
40  !
41  DO imode = 1, nmodes
42     DO na = 1, nat
43        DO icart = 1, 3
44           na_icart = 3*(na-1) + icart
45           dns_pattern(:,:,:,:,imode) = dns_pattern(:,:,:,:,imode) + &
46                            dns_cart(:,:,:,:,icart,na) * u(na_icart,imode)
47        ENDDO
48     ENDDO
49  ENDDO
50  !
51  ! 2 - symmetrize in the pattern basis
52  !
53  imode0 = 1
54  DO irr = 1, nirr
55     npe = npert(irr)
56     ! allocate
57     ALLOCATE (dns_aux(ldim,ldim,nspin,nat,npe))
58     ! pack
59     dns_aux(:,:,:,:,1:npe) = dns_pattern(:,:,:,:,imode0:imode0-1+npe)
60     ! symmetrize
61     CALL sym_dns (ldim, npe, irr, dns_aux)
62     ! unpack
63     dns_pattern(:,:,:,:,imode0:imode0-1+npe) = dns_aux(:,:,:,:,1:npe)
64     ! deallocate
65     DEALLOCATE (dns_aux)
66     ! advance the counter
67     imode0 = imode0 + npe
68  ENDDO
69  !
70  ! 3 - back to the cartesian basis
71  !
72  dns_cart = (0.d0, 0.d0)
73  !
74  DO imode = 1, nmodes
75     DO na = 1, nat
76        DO icart = 1, 3
77           na_icart = 3*(na-1) + icart
78           dns_cart(:,:,:,:,icart,na) = dns_cart(:,:,:,:,icart,na) + &
79               dns_pattern(:,:,:,:,imode) * CONJG(u(na_icart,imode))
80        ENDDO
81     ENDDO
82  ENDDO
83  !
84  RETURN
85  !
86END SUBROUTINE sym_dns_wrapper
87!----------------------------------------------------------------------------
88