1!
2! Copyright (C) 1996-2016	The SIESTA group
3!  This file is distributed under the terms of the
4!  GNU General Public License: see COPYING in the top directory
5!  or http://www.gnu.org/copyleft/gpl.txt.
6! See Docs/Contributors.txt for a list of contributors.
7!
8      module m_cell
9        use precision, only: dp
10        use siesta_geom, only: ucell
11        implicit none
12        real(dp), public, save  :: celli(3,3) = 0.0_dp
13
14        public :: cart2frac, frac2cart
15        public :: write_canonical_ucell
16
17        private
18
19        CONTAINS
20
21        subroutine cart2frac(cart,frac)
22        real(dp), intent(in)  :: cart(3)
23        real(dp), intent(out)  :: frac(3)
24
25        frac =  matmul(transpose(celli),cart)
26        end subroutine cart2frac
27
28        subroutine frac2cart(frac,cart)
29        real(dp), intent(in)  :: frac(3)
30        real(dp), intent(out)  :: cart(3)
31
32        cart =  matmul(ucell,frac)
33        end subroutine frac2cart
34
35      subroutine write_canonical_ucell(iunit,filename)
36      use units, only: Ang
37!
38!     Writes out unit cell information in fdf-compatible format
39!     with LatticeVectors in angstrom.
40!
41        character(len=*), intent(in), optional :: filename
42        integer, intent(in), optional          :: iunit
43
44        integer  :: iu, ix, iv
45        character(len=90)    :: fname
46
47      if (present(iunit)) then
48         iu = iunit
49      else
50         if (present(filename)) then
51            fname = filename
52         else
53            fname = "OUT.UCELL"
54         endif
55         call io_assign( iu )
56         open(iu, file=trim(fname), form='formatted',
57     $        position='rewind', status='unknown')
58      endif
59
60      write(iu,"(a)") "LatticeConstant 1.0 Ang"
61      write(iu,"(a)") "%block LatticeVectors"
62      write(iu,'(3x,3f18.9)')
63     .     ((ucell(ix,iv)/Ang,ix=1,3),iv=1,3)
64      write(iu,"(a)") "%endblock LatticeVectors"
65
66      if (.not. present(iunit)) then
67         call io_close(iu)
68      endif
69
70      end subroutine write_canonical_ucell
71
72      end module m_cell
73!---------------------------------------------------
74