mirror of https://gitlab.com/QEF/q-e.git
99 lines
2.8 KiB
Fortran
99 lines
2.8 KiB
Fortran
!
|
|
! Copyright (C) 2001 PWSCF 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 .
|
|
!
|
|
#include "f_defs.h"
|
|
!
|
|
!-----------------------------------------------------------------------
|
|
SUBROUTINE writed3dyn_5 (d3dyn_x, filename, isw)
|
|
!-----------------------------------------------------------------------
|
|
!
|
|
! writes in a file the third derivative of dynamical matrix
|
|
! isw = +1 : d3dyn_x is in cartesian axis
|
|
! isw = -1 : rotates d3dyn_x from the basis of pattern to
|
|
! cartesian axis
|
|
!
|
|
USE ions_base, ONLY : nat
|
|
USE kinds, ONLY : DP
|
|
USE io_global, ONLY : ionode
|
|
USE pwcom
|
|
USE phcom
|
|
USE d3com
|
|
!
|
|
IMPLICIT NONE
|
|
!
|
|
INTEGER :: isw, iud3dyn, n_d3, na, nb, icart, jcart, kcart, na_i, &
|
|
na_j, na_k
|
|
! input: switch
|
|
! index on cartesian coordinates
|
|
! index on cartesian coordinates
|
|
! index on cartesian coordinates
|
|
! index on modes
|
|
! index on modes
|
|
! index on modes
|
|
|
|
COMPLEX (DP) :: d3dyn_x (3 * nat, 3 * nat, 3 * nat), work
|
|
! input: the third derivative of the dynamical matrix
|
|
COMPLEX (DP), ALLOCATABLE :: aux (:,:,:)
|
|
! auxiliary space
|
|
|
|
CHARACTER (len=*) :: filename
|
|
! input: the name of the file
|
|
|
|
IF ( .NOT. ionode ) RETURN
|
|
|
|
ALLOCATE (aux( 3 * nat, 3 * nat, 3 * nat))
|
|
IF (isw.EQ. + 1) THEN
|
|
CALL ZCOPY (27 * nat * nat * nat, d3dyn_x, 1, aux, 1)
|
|
ELSEIF (isw.EQ. - 1) THEN
|
|
!
|
|
! Rotates third derivative of the dynamical basis from the basis
|
|
! of modes to cartesisn axis
|
|
!
|
|
DO kcart = 1, 3 * nat
|
|
DO icart = 1, 3 * nat
|
|
DO jcart = 1, 3 * nat
|
|
work = (0.d0, 0.d0)
|
|
DO na_k = 1, 3 * nat
|
|
DO na_i = 1, 3 * nat
|
|
DO na_j = 1, 3 * nat
|
|
work = work + CONJG (ug0 (kcart, na_k) ) * u (icart, na_i) &
|
|
* d3dyn_x (na_k, na_i, na_j) * CONJG (u (jcart, na_j) )
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO
|
|
aux (kcart, icart, jcart) = work
|
|
ENDDO
|
|
ENDDO
|
|
|
|
ENDDO
|
|
|
|
ENDIF
|
|
iud3dyn = 57
|
|
|
|
OPEN (unit = iud3dyn, file = TRIM(filename), status = 'unknown')
|
|
DO n_d3 = 1, 3 * nat
|
|
WRITE (iud3dyn, * )
|
|
WRITE (iud3dyn, * ) ' modo:', n_d3
|
|
WRITE (iud3dyn, * )
|
|
DO na = 1, nat
|
|
DO nb = 1, nat
|
|
WRITE (iud3dyn, '(2i3)') na, nb
|
|
DO icart = 1, 3
|
|
WRITE (iud3dyn, '(3E24.12)') (aux (n_d3, icart + 3 * (na - 1) , &
|
|
jcart + 3 * (nb - 1) ) , jcart = 1, 3)
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO
|
|
|
|
ENDDO
|
|
|
|
CLOSE (iud3dyn)
|
|
|
|
DEALLOCATE (aux)
|
|
RETURN
|
|
END SUBROUTINE writed3dyn_5
|