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