1*
2* $Id$
3*
4
5*     *****************************************************
6*     *                                                   *
7*     *                setup_kbpp_band                    *
8*     *                                                   *
9*     *****************************************************
10
11      subroutine setup_kbpp_band(nfft1,nfft2,nfft3,unita,unitg,G)
12      implicit none
13      integer nfft1,nfft2,nfft3
14      double precision unita(3,3),unitg(3,3)
15      double precision G(nfft1,nfft2,nfft3,3)
16
17*     **** local variables *****
18      integer i,j,k
19      integer k1,k2,k3
20      integer nffth1,nffth2,nffth3
21      double precision g1,g2,g3,dk1,dk2,dk3
22
23
24      call get_unitg_band(unita,unitg)
25
26      nffth3 = nfft3/2
27      nffth2 = nfft2/2
28      nffth1 = nfft1/2
29*     **** less confusing algorithm ****
30      do k3 = -nffth3+1, nffth3
31         do k2 = -nffth2+1, nffth2
32            do k1 = -nffth1+1,nffth1
33               dk1=dble(k1)
34               dk2=dble(k2)
35               dk3=dble(k3)
36               g1 = dk1*unitg(1,1) + dk2*unitg(1,2) + dk3*unitg(1,3)
37               g2 = dk1*unitg(2,1) + dk2*unitg(2,2) + dk3*unitg(2,3)
38               g3 = dk1*unitg(3,1) + dk2*unitg(3,2) + dk3*unitg(3,3)
39               i=k1
40               j=k2
41               k=k3
42               if (i .lt. 0) i = i + nfft1
43               if (j .lt. 0) j = j + nfft2
44               if (k .lt. 0) k = k + nfft3
45
46               G(i+1,j+1,k+1,1) = g1
47               G(i+1,j+1,k+1,2) = g2
48               G(i+1,j+1,k+1,3) = g3
49
50            end do
51         end do
52      end do
53
54
55      return
56      end
57
58
59      subroutine get_unitg_band(unita,unitg)
60      implicit none
61
62******************************************************************************
63*                                                                            *
64*     This routine computes primitive vectors                                *
65*               in reciporocal space and the volume of primitive cell.       *
66*                                                                            *
67*     Inputs:                                                                *
68*             unita  --- primitive vectors in coordination space             *
69*                                                                            *
70*     Outputs:                                                               *
71*             unitg  --- primitive vectors in reciprocal space               *
72*                                                                            *
73*     Library:  dscal from BLAS                                              *
74*                                                                            *
75*     Last modification:  3/30/99  by Eric Bylaska                           *
76*                                                                            *
77******************************************************************************
78
79
80*     ------------------
81*     argument variables
82*     ------------------
83      double precision unita(3,3), unitg(3,3)
84
85*     ---------------
86*     local variables
87*     ---------------
88      double precision volume
89      double precision twopi
90
91      twopi = 8.0d0*datan(1.0d0)
92
93
94*     -----------------------------------------
95*     primitive vectors in the reciprocal space
96*     -----------------------------------------
97      unitg(1,1) = unita(2,2)*unita(3,3) - unita(3,2)*unita(2,3)
98      unitg(2,1) = unita(3,2)*unita(1,3) - unita(1,2)*unita(3,3)
99      unitg(3,1) = unita(1,2)*unita(2,3) - unita(2,2)*unita(1,3)
100      unitg(1,2) = unita(2,3)*unita(3,1) - unita(3,3)*unita(2,1)
101      unitg(2,2) = unita(3,3)*unita(1,1) - unita(1,3)*unita(3,1)
102      unitg(3,2) = unita(1,3)*unita(2,1) - unita(2,3)*unita(1,1)
103      unitg(1,3) = unita(2,1)*unita(3,2) - unita(3,1)*unita(2,2)
104      unitg(2,3) = unita(3,1)*unita(1,2) - unita(1,1)*unita(3,2)
105      unitg(3,3) = unita(1,1)*unita(2,2) - unita(2,1)*unita(1,2)
106      volume = unita(1,1)*unitg(1,1)
107     >       + unita(2,1)*unitg(2,1)
108     >       + unita(3,1)*unitg(3,1)
109
110      call dscal(9,twopi/volume,unitg,1)
111
112*     ---------------------
113*     volume of a unit cell
114*     ---------------------
115      volume=dabs(volume)
116
117      return
118      end
119