Line data Source code
1 : !!****m* ABINIT/m_atprj
2 : !!
3 : !! NAME
4 : !! m_atprj
5 : !!
6 : !! FUNCTION
7 : !! Module to output atomic projections of phonon modes
8 : !!
9 : !! COPYRIGHT
10 : !! Copyright (C) 2011-2026 ABINIT group (MJV)
11 : !! This file is distributed under the terms of the
12 : !! GNU General Public Licence, see ~abinit/COPYING
13 : !! or http://www.gnu.org/copyleft/gpl.txt .
14 : !! For the initials of contributors, see ~abinit/doc/developers/contributors.txt .
15 : !!
16 : !! SOURCE
17 :
18 : #if defined HAVE_CONFIG_H
19 : #include "config.h"
20 : #endif
21 :
22 : #include "abi_common.h"
23 :
24 : module m_atprj
25 :
26 : use defs_basis
27 : use m_abicore
28 : use m_errors
29 :
30 : use m_io_tools, only : get_unit, open_file
31 : use m_fstrings, only : int2char4
32 :
33 : implicit none
34 :
35 : private
36 : !!***
37 :
38 : !!****t* m_atprj/atprj_type
39 : !! NAME
40 : !! atprj_type
41 : !!
42 : !! FUNCTION
43 : !! Container for atomic projection file data
44 : !!
45 : !! SOURCE
46 :
47 : type, public :: atprj_type
48 :
49 : integer :: natprj_bs
50 : integer :: natom
51 :
52 : integer, allocatable :: iatprj_bs(:)
53 : character(len=fnlen), allocatable :: filename(:,:)
54 :
55 : contains
56 :
57 : procedure :: init => atprj_init
58 : procedure :: print => atprj_print
59 : procedure :: free => atprj_free
60 :
61 : end type atprj_type
62 :
63 : contains
64 : !!***
65 :
66 : !!****f* m_atprj/atprj_init
67 : !!
68 : !! NAME
69 : !! atprj_init
70 : !!
71 : !! FUNCTION
72 : !! initialize atprj datastructure
73 : !!
74 : !! INPUT
75 : !! natom = number of atoms
76 : !! natprj_bs = number of atoms to project on
77 : !! iatprj_bs = indices of atoms to project on
78 : !! outfile_radix = base file name for output files
79 : !!
80 : !! OUTPUT
81 : !! atprj = container object for atomic projections
82 : !!
83 : !! SOURCE
84 :
85 3 : subroutine atprj_init(atprj, natom, natprj_bs, iatprj_bs, outfile_radix)
86 :
87 : class(atprj_type), intent(out) :: atprj
88 : integer, intent(in) :: natom, natprj_bs
89 : integer, intent(in) :: iatprj_bs(natprj_bs)
90 : character(len=*), intent(in) :: outfile_radix
91 :
92 : !Local variables-------------------------------
93 : !scalars
94 : integer :: iatom, imode, iunit
95 : character(len=10) :: imodestring, iatomstring
96 : character(len=500) :: msg
97 : ! *************************************************************************
98 :
99 3 : atprj%natprj_bs = natprj_bs
100 3 : atprj%natom = natom
101 :
102 9 : ABI_MALLOC(atprj%iatprj_bs,(natprj_bs))
103 12 : atprj%iatprj_bs = iatprj_bs
104 :
105 : ! for each phonon mode and atom for projection, open a file
106 12 : ABI_MALLOC(atprj%filename ,(3*natom,natprj_bs))
107 3 : iunit = get_unit()
108 21 : do imode = 1, 3*natom
109 18 : call int2char4(imode, imodestring)
110 18 : ABI_CHECK((imodestring(1:1)/='#'),'Bug: string length too short!')
111 57 : do iatom = 1, natprj_bs
112 36 : call int2char4(iatom, iatomstring)
113 36 : ABI_CHECK((iatomstring(1:1)/='#'),'Bug: string length too short!')
114 36 : atprj%filename(imode,iatom) = trim(outfile_radix)//"_mod"//trim(imodestring)//"_iat"//trim(iatomstring)
115 36 : if (open_file(atprj%filename(imode,iatom), msg, newunit=iunit, form="formatted", action="write") /= 0) then
116 0 : ABI_ERROR(msg)
117 : end if
118 : ! print header
119 36 : write (unit=iunit, fmt='(a)') '##'
120 36 : write (unit=iunit, fmt='(a,I6,a)') '## This file contains abinit phonon frequencies for mode number ', &
121 72 : imode, ' along a path in reciprocal space,'
122 36 : write (unit=iunit, fmt='(a,I6)') '## the third column is the projection along atom number ',atprj%iatprj_bs(iatom)
123 36 : write (unit=iunit, fmt='(a)') '##'
124 :
125 54 : close (iunit)
126 : end do
127 : end do
128 :
129 3 : end subroutine atprj_init
130 : !!***
131 :
132 : !!****f* m_atprj/atprj_print
133 : !! NAME
134 : !! atprj_print
135 : !!
136 : !! FUNCTION
137 : !! print out 1 line per atomic projection file
138 : !!
139 : !! INPUT
140 : !! atprj = container object for atomic projections
141 : !! phfrq = phonon frequencies for present q point
142 : !! eigvec = eigenvectors for present q point
143 : !!
144 : !! OUTPUT
145 : !! writes to files
146 : !!
147 : !! SOURCE
148 :
149 6 : subroutine atprj_print(atprj, iq, phfrq, eigvec)
150 :
151 : !arguments
152 : class(atprj_type), intent(in) :: atprj
153 : integer, intent(in) :: iq
154 : real(dp), intent(in) :: phfrq(3*atprj%natom)
155 : real(dp), intent(in) :: eigvec(2,3,atprj%natom,3,atprj%natom)
156 :
157 : !local variables
158 : integer :: jatom, idir, iatom, imode, iunit, jdir
159 : real(dp) :: proj
160 :
161 : ! *************************************************************************
162 :
163 6 : iunit = get_unit()
164 18 : do iatom = 1, atprj%natom
165 54 : do idir = 1, 3
166 36 : imode = idir + 3*(iatom-1)
167 120 : do jatom = 1, atprj%natprj_bs
168 72 : open (unit=iunit, file=atprj%filename(imode,jatom), position='append')
169 72 : write (unit=iunit, fmt='(a,I4,a)') '# atom ', jatom, ' sum of directions'
170 720 : proj = sum(eigvec(:,:,jatom,idir,iatom)**2)
171 72 : write (unit=iunit, fmt='(I6,2E20.10)') iq, phfrq(imode), proj
172 :
173 288 : do jdir = 1, 3
174 216 : write (unit=iunit, fmt='(2a,I4,a,I4)') ch10, '# atom ', jatom, ' directions ', jdir
175 648 : proj = sum(eigvec(:,jdir,jatom,idir,iatom)**2)
176 288 : write (unit=iunit, fmt='(I6,2E20.10)') iq, phfrq(imode), proj
177 : end do
178 108 : close (iunit)
179 : end do
180 : end do
181 : end do
182 :
183 6 : end subroutine atprj_print
184 : !!***
185 :
186 : !!****f* m_atprj/atprj_free
187 : !!
188 : !! NAME
189 : !! atprj_free
190 : !!
191 : !! FUNCTION
192 : !! deallocate atomic projection datastructure and close files
193 : !!
194 : !! INPUT
195 : !!
196 : !! OUTPUT
197 : !! atprj = container object for atomic projections
198 : !!
199 : !! SOURCE
200 :
201 3 : subroutine atprj_free(atprj)
202 :
203 : class(atprj_type), intent(inout) :: atprj
204 :
205 3 : ABI_SFREE(atprj%iatprj_bs)
206 3 : ABI_SFREE(atprj%filename)
207 :
208 3 : end subroutine atprj_free
209 :
210 6 : end module m_atprj
211 : !!***
|
