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!-----------------------------------------------------------------------
9subroutine tra_write_matrix (alpha, adyn, u, nat)
10  !-----------------------------------------------------------------------
11  !
12  ! This routine writes on output the symmetrized dynamical matrix in
13  ! cartesian coordinates. The input matrix adyn is in the basis of
14  ! the modes. On output adyn is unchanged.
15  !
16  USE io_global,    ONLY : stdout
17  USE kinds,        ONLY : DP
18  USE cell_base,    ONLY : at, bg
19  USE symm_base,    ONLY : s, irt, invs
20  USE lr_symm_base, ONLY : rtau, nsymq, irotmq, minus_q
21  USE qpoint,       ONLY : xq
22
23  implicit none
24  integer :: i, j, na, nb, nat
25  complex(DP) :: adyn (3 * nat, 3 * nat), u (3 * nat, 3 * nat)
26  complex(DP) :: auxdyn (3*nat, 3*nat)
27  character (len=*) :: alpha
28
29  auxdyn=adyn
30  CALL symdyn_munu_new (auxdyn, u, xq, s, invs, rtau, irt, at, bg, &
31          nsymq, nat, irotmq, minus_q)
32
33  WRITE( stdout, '(a)') alpha
34  do na = 1, nat
35     do nb = 1, nat
36        WRITE( stdout, '(2i4)') na, nb
37        do i = 1, 3
38           WRITE( stdout, '(6f12.7)') (auxdyn(3*(na-1)+i, 3*(nb-1)+j),j=1,3)
39        enddo
40     enddo
41  enddo
42  return
43end subroutine tra_write_matrix
44
45!-----------------------------------------------------------------------
46subroutine tra_write_matrix_no_sym (alpha, adyn, nat)
47  !-----------------------------------------------------------------------
48  !
49  ! This routine writes on output the symmetrized dynamical matrix in
50  ! cartesian coordinates. The input matrix adyn is in the basis of
51  ! the modes. On output adyn is unchanged.
52  !
53  USE io_global,    ONLY : stdout
54  USE kinds,        ONLY : DP
55
56  implicit none
57  integer :: i, j, na, nb, nat
58  complex(DP) :: adyn (3 * nat, 3 * nat)
59  character (len=*) :: alpha
60
61  WRITE( stdout, '(a)') alpha
62  do na = 1, nat
63     do nb = 1, nat
64        WRITE( stdout, '(2i4)') na, nb
65        do i = 1, 3
66           WRITE( stdout, '(6f12.7)') (adyn(3*(na-1)+i, 3*(nb-1)+j),j=1,3)
67        enddo
68     enddo
69  enddo
70  return
71end subroutine tra_write_matrix_no_sym
72