1!=========================================================================== 2! 3! Routines: 4! 5! (1) rqstar() Originally By SIB Last Modified 9/1/2010 (DAS) 6! 7! Takes vector rq (in irr. zone) and applies all the symmetries 8! of current q-vector to it, and compiles a list of the unique vectors 9! thus generated. On exit, 10! nstar = number of such vectors 11! insdt = indices of symmetries which generate them, where indices 12! are in the list of those of q (subgroup). 13! 14!=========================================================================== 15 16#include "f_defs.h" 17 18subroutine rqstar(syms,nstar,indst,rq) 19 20 use global_m 21 use misc_m 22 implicit none 23 24 type (symmetry), intent(in) :: syms 25 integer, intent(out) :: nstar,indst(*) 26 real(DP), intent(in) :: rq(3) 27 28 integer :: it,istar,gpt(3) 29 real(DP) :: qk(3),rqs(3,48) 30 logical :: found 31 32!-------------- loop over elements of subgroup --------------------------- 33 34 PUSH_SUB(rqstar) 35 36 nstar = 0 37 do it = 1, syms%ntranq 38 39! Rotate rq, so qk = syms%mtrix(indsub(it))*rq, 40! and ensure qk(i) is between 0 and 1. 41 42 qk(1:3) = matmul(syms%mtrx(1:3, 1:3, syms%indsub(it)), rq(1:3)) 43 call k_range(qk(1:3), gpt(1:3), TOL_Small) 44 45! Compare to other elements of star to see if it is already present 46 found = .false. 47 do istar = 1, nstar 48 if (all(abs(qk(1:3) - rqs(1:3, istar)) .lt. TOL_Small)) then 49 found = .true. 50 exit 51 endif 52 enddo 53 54 if(.not. found) then 55! Store new element of star and rotation which gives it 56 nstar = nstar + 1 57 rqs(1:3, nstar) = qk(1:3) 58 indst(nstar) = it 59 endif 60 enddo 61 62!-------------- end loop over elements of subgroup ----------------------- 63 64 POP_SUB(rqstar) 65 66 return 67end subroutine rqstar 68