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