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 9 module m_struct 10! 11! Cell vectors in Angstroms 12! Atomic positions in fractional coordinates 13 14! Alberto Garcia, Sep. 2005. Based on ioxv by J.M.Soler. July 1997. 15 16 implicit none 17 18 integer, parameter, private :: dp = selected_real_kind(14,100) 19 real(dp), parameter, private :: Ang = 1._dp / 0.529177_dp 20 21 type, public :: struct_t 22 integer :: na = 0 23 real(dp):: cell(3,3) 24 real(dp), allocatable :: xa(:,:) 25 integer, allocatable :: isa(:) 26 integer, allocatable :: iza(:) 27 end type 28 29 public :: write_struct 30 public :: read_struct 31 public :: clean_struct 32 public :: replicate_struct 33 34 private 35 36 interface 37 subroutine die(str) 38 character(len=*), intent(in), optional :: str 39 end subroutine die 40 end interface 41 42 CONTAINS 43 44 subroutine clean_struct(str) 45 type(struct_t), intent(inout) :: str 46 47 if (allocated(str%xa)) then 48 deallocate(str%xa) 49 endif 50 if (allocated(str%isa)) then 51 deallocate(str%isa) 52 endif 53 if (allocated(str%iza)) then 54 deallocate(str%iza) 55 endif 56 str%cell = 0.0_dp 57 str%na = 0 58 end subroutine clean_struct 59 60 61 subroutine read_struct( fname, str) 62! 63 character(len=*), intent(in) :: fname 64 type(struct_t), intent(inout) :: str 65 66 real(dp) :: xfrac(3) 67 integer :: ia, iv 68 integer :: ix, iostat, na 69 70 integer :: iu = 1 71 72 call clean_struct(str) 73 74 open(iu,file=fname,form='formatted', & 75 status='old', iostat=iostat) 76 if (iostat /= 0) call die(trim(fname) // " not found") 77 78 read(iu,*) ((str%cell(ix,iv),ix=1,3),iv=1,3) 79 str%cell = str%cell * Ang 80 read(iu,*) na 81 str%na = na 82 allocate(str%xa(3,na),str%isa(na),str%iza(na)) 83 84 do ia = 1,na 85 read(iu,*) str%isa(ia), str%iza(ia), xfrac(1:3) 86 str%xa(:,ia) = matmul(str%cell,xfrac(1:3)) 87 enddo 88 close(iu) 89 90 end subroutine read_struct 91 92!--------------------------------------------------------------------- 93 subroutine write_struct(fname, str) 94! 95 character(len=*), intent(in) :: fname 96 type(struct_t), intent(in) :: str 97 98! Internal variables and arrays 99 real(dp) :: celli(3,3) 100 real(dp) :: xfrac(3) 101 integer :: ia, iv, ix 102 103 integer :: iu = 1 104 105 open( iu, file=fname, form='formatted', status='unknown' ) 106 107 write(iu,'(3x,3f18.9)') ((str%cell(ix,iv)/Ang,ix=1,3),iv=1,3) 108 write(iu,*) str%na 109 call reclat(str%cell, celli, 0) 110 do ia = 1,str%na 111 xfrac(:) = matmul(transpose(celli),str%xa(:,ia)) 112 write(iu,'(i3,i6,3f18.9)') str%isa(ia),str%iza(ia),xfrac(1:3) 113 enddo 114 115 close(iu) 116 117 end subroutine write_struct 118 119 subroutine replicate_struct(str0,nsc,str) 120! 121 type(struct_t), intent(inout) :: str0 122 integer, intent(in) :: nsc(3) 123 type(struct_t), intent(inout) :: str 124 125 real(dp) :: xc(3) 126 integer :: ia, iv, ja 127 integer :: ix, na, na0 128 integer :: i1, i2, i3 129 130 call clean_struct(str) 131 do iv = 1, 3 132 str%cell(:,iv) = nsc(iv) * str0%cell(:,iv) 133 enddo 134 na0 = str0%na 135 str%na = na0 * product(nsc(1:3)) 136 137 na = str%na 138 allocate(str%xa(3,na),str%isa(na),str%iza(na)) 139 140 do ia = 1,na 141 ja = mod(ia-1,na0) + 1 142 str%isa(ia) = str0%isa(ja) 143 str%iza(ia) = str0%iza(ja) 144 enddo 145 146 ia = 0 147 148 DO I3 = 0,NSC(3)-1 149 DO I2 = 0,NSC(2)-1 150 DO I1 = 0,NSC(1)-1 151 152 do IX = 1,3 153 XC(IX) = str0%cell(IX,1)*I1 + & 154 str0%cell(IX,2)*I2 + & 155 str0%cell(IX,3)*I3 156 enddo 157 do JA = 1,NA0 158 IA = IA + 1 159 do IX = 1,3 160 str%XA(IX,IA) = str0%XA(IX,JA) + XC(IX) 161 enddo 162 enddo 163 164 enddo 165 enddo 166 enddo 167 168 end subroutine replicate_struct 169 end module m_struct 170 171