1! 2! Copyright (C) 2001 PWSCF 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 trnvecc( u, at, bg, iflg ) 11 !----------------------------------------------------------------------- 12 !! Transforms a COMPLEX vector in real space (like a displacement) 13 !! from crystal to cartesian axis (iflag.gt.0) and viceversa (iflag.le.0 14 ! 15 USE kinds, ONLY : DP 16 ! 17 IMPLICIT NONE 18 ! 19 INTEGER :: iflg 20 !! input: gives the versus of the transformatio 21 REAL(DP) :: at(3,3) 22 !! input: the direct lattice vectors 23 REAL(DP) :: bg(3,3) 24 !! input: the reciprocal lattice vectors 25 COMPLEX(DP) :: u(3) 26 !! I/O: the vector to transform 27 ! 28 ! ... local variables 29 ! 30 INTEGER :: i, k 31 ! counter on polarizations 32 COMPLEX(DP) :: wrk(3) 33 ! auxiliary variable 34 ! 35 ! 36 IF (iflg > 0) THEN 37 ! 38 ! forward transformation : 39 ! 40 DO i = 1, 3 41 wrk(i) = u(i) 42 ENDDO 43 ! 44 DO i = 1, 3 45 u(i) = 0.d0 46 DO k = 1, 3 47 u(i) = u(i) + wrk(k) * at(i,k) 48 ENDDO 49 ENDDO 50 ELSE 51 ! 52 ! backward transformation : 53 ! 54 DO i = 1, 3 55 wrk(i) = 0.d0 56 DO k = 1, 3 57 wrk(i) = wrk(i) + u(k) * bg(k, i) 58 ENDDO 59 ENDDO 60 ! 61 DO i = 1, 3 62 u(i) = wrk(i) 63 ENDDO 64 ! 65 ENDIF 66 ! 67 ! 68 RETURN 69 ! 70END SUBROUTINE trnvecc 71