      subroutine generateb(a,aa,b,c,BB)

C     Transformation taken from Acta. Cryst. (1967) 22, 457-464
C     by William R. Busing and Henri A. Levy.

      implicit none
c...    passed variables
      real a(3),b(3),aa(3),BB(3,3),c
      
c...	local variables
      real pi
      real cosa(3),sina(3),cosb(3),sinb(3)
      integer i,j,k
      character*1 key
      pi=4.0*atan(1.0)
      
 50   do i=1,3
        cosa(i)=cos(pi*aa(i)/180)
        sina(i)=sin(pi*aa(i)/180)
      enddo
      
      c=sqrt(1-cosa(1)**2-cosa(2)**2-cosa(3)**2+2*cosa(1)*
     &  cosa(2)*cosa(3))

      if ((a(1).eq.0).or.(a(2).eq.0).or.(a(3).eq.0)) then
         write(*,'(a)') 'Lattice parameters are unsuitable!'
         write(*,301) 'Currently a,b,c=',a(1),',',a(2),',',a(3),'.'
 301     format(a,f7.4,a1,f7.4,a1,f7.4,a1)
         write(*,'(a,$)') 'Continue (y)/n? '
         read (*,'(a)') key
         if (key.eq.'n') stop
         write(*,'(a,$)') 'Enter new a,b,c:'
         read(*,*) (a(i),i=1,3)
         goto 50
      endif
      if ((c.eq.0.0).or.
     &   (sina(1).eq.0).or.(sina(2).eq.0).or.(sina(3).eq.0)) then
         write(*,'(a)') 'Lattice angles are unsuitable!'
         write(*,302) 'Alpha,beta,gamma=',aa(1),',',aa(2),',',aa(3),
     &              '.'
 302     format(a,f6.2,a1,f6.2,a1,f6.2,a1)
         write(*,'(a,$)') 'Continue (y)/n? '
         read (*,'(a)') key
         if (key.eq.'n') stop
         write(*,'(a,$)') 'Enter new alpha,beta,gamma:'
         read(*,*) (aa(i),i=1,3)
         goto 50
      endif

      do i=1,3
        call ijk(i,j,k)
        b(i)=2.0*pi*sina(i)/(a(i)*c)
        cosb(i)=(cosa(j)*cosa(k)-cosa(i))/
     &    (sina(j)*sina(k))
        sinb(i)=sqrt(1-cosb(i)**2)
      enddo
      BB(1,1)=b(1)
      BB(2,1)=0
      BB(3,1)=0
      BB(1,2)=b(2)*cosb(3)
      BB(2,2)=b(2)*sinb(3)
      BB(3,2)=0
      BB(1,3)=b(3)*cosb(2)
      BB(2,3)=-b(3)*sinb(2)*cosa(1)
      BB(3,3)=2.0*pi/a(3)
      return
      end

C****************************************************
      
      subroutine generatea(amat,bmat)
      implicit none

c...	passed variables
      real amat(3,3),bmat(3,3)

c...	local variables      
      real a(3),b(3),c(3),pi, d
      integer i, j, k, l
      
      pi=4.0*atan(1.0)
      
C     Calculate b[1].(b[2]xb[3])
      
      d=(bmat(1,1)*bmat(2,2)*bmat(3,3)+bmat(1,2)*bmat(2,3)*bmat(3,1)+
     &  bmat(2,1)*bmat(3,2)*bmat(1,3)-bmat(3,1)*bmat(2,2)*bmat(1,3)-
     &  bmat(2,1)*bmat(1,2)*bmat(3,3)-bmat(1,1)*bmat(3,2)*bmat(2,3))
     & /(2.0*pi)
      
C     i index refers to 

      do i=1,3
        call ijk(i,j,k)
        do l=1,3
          a(l)=bmat(l,j)
          b(l)=bmat(l,k)
        enddo
        call cross(a,b,c)
        do l=1,3
          amat(l,i)=c(l)/d
        enddo
      enddo
      return
      end

C********************************************************************

      subroutine ijk(i,j,k)
      implicit none

c...	passed variables
      integer i,j,k
      
      if (i.eq.1) then
        j=2
        k=3
      else if (i.eq.2) then
        j=3
        k=1
      else
        j=1
        k=2
      endif

      return
      end
