Branch data 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 : : !!***
|
