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