Line data Source code
1 :
2 : #if defined HAVE_CONFIG_H
3 : #include "config.h"
4 : #endif
5 :
6 : #include "abi_common.h"
7 :
8 : module m_tdep_utils
9 :
10 : use defs_basis
11 : use m_errors
12 : use m_abicore
13 : use m_xmpi
14 : use m_io_tools
15 : use m_tdep_dataset, only : atdep_dataset_type, MPI_enreg_type
16 : use m_tdep_latt, only : Lattice_type
17 : use m_tdep_sym, only : Symmetries_type
18 : use m_tdep_shell, only : Shell_type
19 : use m_tdep_model, only : tdep_Model_type
20 : use m_tdep_phi3, only : tdep_build_phi3_333
21 : use m_tdep_phi4, only : tdep_build_phi4_3333
22 :
23 : implicit none
24 :
25 : public :: tdep_check_constraints
26 : public :: tdep_print_Aknowledgments
27 :
28 : contains
29 :
30 : !====================================================================================================
31 :
32 44 : subroutine tdep_check_constraints(Model,distance,Invar,Sym,Shell3at,Shell4at)
33 :
34 : type(tdep_Model_type),intent(in) :: Model
35 : type(atdep_dataset_type),intent(in) :: Invar
36 : double precision, intent(in) :: distance(Invar%natom,Invar%natom,4)
37 : type(Symmetries_type),intent(in) :: Sym
38 : type(Shell_type), intent(in) :: Shell3at
39 : type(Shell_type), intent(in) :: Shell4at
40 :
41 : integer :: ii,jj,kk,ll,iatom,jatom,katom,latom,isym,itrans
42 : integer :: alpha,beta,gama,lambda
43 : integer :: ishell,iatshell
44 : double precision :: norm1
45 : double precision :: Kroenecker(3,3),Phi3_333(3,3,3),Phi4_3333(3,3,3,3)
46 44 : double precision, allocatable :: asr3(:,:,:,:,:),rot3(:,:,:,:,:)
47 44 : double precision, allocatable :: asr4(:,:,:,:,:,:)
48 : integer :: ierr
49 : logical :: order2,order3,order4
50 :
51 44 : ierr = 0;
52 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
53 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Compute the acoustic sum rule and the !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
54 : !!!!!!!!!!!!!!!!!!!!!!!!!!! invariance under an arbitrary rotation of the system !!!!!!!!!!!!!!!!!!!!!!!
55 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
56 44 : Kroenecker(:,:)=zero
57 44 : Kroenecker(1,1)=1 ; Kroenecker(2,2)=1 ; Kroenecker(3,3)=1
58 :
59 44 : order2 = .false.
60 44 : order3 = .false.
61 44 : order4 = .false.
62 44 : if (Invar%order.ge.2) order2=.true.
63 44 : if (Invar%order.ge.3) order3=.true.
64 : !FB4th if (Invar%order.ge.4) order4=.true.
65 : if (Invar%order.ge.4) order4=.false.
66 :
67 44 : if (order2) then
68 : ! FIRST ORDER
69 : ! Acoustic sum rule (first order)'
70 176 : do alpha=1,3
71 132 : norm1=zero
72 450 : do iatom=1,Invar%natom_unitcell
73 450 : norm1=norm1+Model%Phi1((iatom-1)*3+alpha)
74 : enddo
75 176 : if (abs(norm1).gt.tol8) then
76 0 : write(std_out,'(a,1(i3,1x),1(e17.10,1x))') '>>>>> WARNING (ASR1) : alpha,Sum =',alpha,norm1
77 0 : if (abs(norm1).gt.tol6) then
78 0 : ABI_WARNING('The acoustic sum rule is not fulfilled (order 1)')
79 : end if
80 : end if
81 : enddo
82 : ! Invariance under an arbitrary rotation (first order)'
83 176 : do alpha=1,3
84 572 : do beta=1,3
85 396 : norm1=zero
86 1350 : do iatom=1,Invar%natom_unitcell
87 : norm1=norm1+Model%Phi1(3*(iatom-1)+alpha)*distance(1,iatom,beta +1)-&
88 1350 : & Model%Phi1(3*(iatom-1)+beta )*distance(1,iatom,alpha+1)
89 : end do !iatom
90 528 : if (abs(norm1).gt.tol8) then
91 0 : write(std_out,'(a,2(i3,1x),1(e17.10,1x))') '>>>>> WARNING (ROT1) : alpha,beta,Sum=',alpha,beta,norm1
92 0 : if (abs(norm1).gt.tol6) then
93 0 : ABI_WARNING('The invariance under arbitrary rotation is not fulfilled (order 1)')
94 : end if
95 : end if
96 : end do !beta
97 : end do !alpha
98 :
99 : ! SECOND ORDER
100 : ! Acoustic sum rule (second order)
101 6926 : do iatom=1,Invar%natom
102 27572 : do alpha=1,3
103 89466 : do beta=1,3
104 61938 : norm1=zero
105 13312710 : do jatom=1,Invar%natom
106 13312710 : norm1=norm1+Model%Phi2%SR((iatom-1)*3+alpha,3*(jatom-1)+beta)
107 : enddo
108 82584 : if (abs(norm1).gt.tol8) then
109 0 : write(std_out,'(a,3(i3,1x),1(e17.10,1x))') '>>>>> WARNING (ASR2) : iatom,alpha,beta,Sum =',iatom,alpha,beta,norm1
110 0 : if (abs(norm1).gt.tol6) then
111 0 : ABI_WARNING('The acoustic sum rule is not fulfilled (order 2)')
112 : end if
113 : end if
114 : enddo
115 : enddo
116 : enddo
117 : ! Invariance under an arbitrary rotation (first and second order)'
118 6926 : do iatom=1,Invar%natom
119 27572 : do alpha=1,3
120 89466 : do beta=1,3
121 268398 : do gama=1,3
122 185814 : norm1=zero
123 39938130 : do jatom=1,Invar%natom
124 : norm1=norm1+Model%Phi2%SR(3*(iatom-1)+alpha,3*(jatom-1)+beta)*distance(iatom,jatom,gama+1)-&
125 39938130 : & Model%Phi2%SR(3*(iatom-1)+alpha,3*(jatom-1)+gama)*distance(iatom,jatom,beta+1)
126 : end do !jatom
127 : norm1=norm1+Model%Phi1(3*(iatom-1)+beta)*Kroenecker(alpha,gama)&
128 185814 : & -Model%Phi1(3*(iatom-1)+gama)*Kroenecker(alpha,beta)
129 247752 : if (abs(norm1).gt.tol8) then
130 9208 : write(std_out,'(a,4(i3,1x),1(e17.10,1x))') '>>>>> WARNING (ROT2) : iatom,alpha,beta,gama,Sum =',&
131 18416 : & iatom,alpha,beta,gama,norm1
132 9208 : if (abs(norm1).gt.tol4) then
133 0 : ABI_WARNING('The invariance under arbitrary rotation is not fulfilled (order 2)')
134 : end if
135 : end if
136 : end do !gama
137 : end do !beta
138 : end do !alpha
139 : end do !iatom
140 : end if !order=1,2
141 :
142 44 : if (order3) then
143 : ! THIRD ORDER
144 207518 : ABI_MALLOC(rot3,(Invar%natom,3,3,3,3)) ; rot3(:,:,:,:,:)=0.d0
145 206384 : ABI_MALLOC(asr3,(2,Invar%natom,3,3,3)) ; asr3(:,:,:,:,:)=0.d0
146 2554 : do iatom=1,Invar%natom
147 40261724 : rot3(:,:,:,:,:)=0.d0
148 40055984 : asr3(:,:,:,:,:)=0.d0
149 495804 : do jatom=1,Invar%natom
150 493264 : if (distance(iatom,jatom,1).gt.Invar%rcut3) cycle
151 : ! Compute the rotational invariance (third order)
152 60636 : do alpha=1,3
153 667552 : do beta=1,3
154 566436 : do gama=1,3
155 1699308 : do lambda=1,3
156 : rot3(jatom,alpha,beta,gama,lambda)=rot3(jatom,alpha,beta,gama,lambda)+&
157 : & Model%Phi2%SR(3*(iatom-1)+gama ,3*(jatom-1)+beta )*Kroenecker(alpha,lambda)+&
158 : & Model%Phi2%SR(3*(iatom-1)+alpha ,3*(jatom-1)+gama )*Kroenecker(beta,lambda)-&
159 : & Model%Phi2%SR(3*(iatom-1)+lambda,3*(jatom-1)+beta )*Kroenecker(alpha,gama)-&
160 1568592 : & Model%Phi2%SR(3*(iatom-1)+alpha ,3*(jatom-1)+lambda)*Kroenecker(beta,gama)
161 : end do !lambda
162 : end do !gama
163 : end do !beta
164 : end do !alpha
165 : end do !jatom
166 10868 : do ishell=1,Shell3at%nshell
167 : ! Build the 3x3x3 IFC of an atom in this shell
168 8328 : if (Shell3at%neighbours(iatom,ishell)%n_interactions.eq.0) cycle
169 88976 : do iatshell=1,Shell3at%neighbours(iatom,ishell)%n_interactions
170 79388 : jatom=Shell3at%neighbours(iatom,ishell)%atomj_in_shell(iatshell)
171 79388 : katom=Shell3at%neighbours(iatom,ishell)%atomk_in_shell(iatshell)
172 79388 : isym =Shell3at%neighbours(iatom,ishell)%sym_in_shell(iatshell)
173 79388 : itrans=Shell3at%neighbours(iatom,ishell)%transpose_in_shell(iatshell)
174 79388 : call tdep_build_phi3_333(isym,Model%Phi3(:,:,:,ishell),Phi3_333,Sym,itrans)
175 : ! Compute the first ASR : sum_k Phi3_ijk=0
176 : ! --> Phi3_iji+sum_{k.ne.i} Phi3_ijk=0
177 : ! --> if i.eq.j Phi3_iii+sum_{k.ne.i} Phi3_iik
178 3175520 : asr3(1,jatom,:,:,:)=asr3(1,jatom,:,:,:)+Phi3_333(:,:,:)
179 : ! Compute the second ASR : sum_j Phi3_ijk=0
180 3175520 : asr3(2,katom,:,:,:)=asr3(2,katom,:,:,:)+Phi3_333(:,:,:)
181 : ! Compute the rotational invariance (third order)
182 325880 : do alpha=1,3
183 1032044 : do beta=1,3
184 3096132 : do gama=1,3
185 9288396 : do lambda=1,3
186 : rot3(jatom,alpha,beta,gama,lambda)=rot3(jatom,alpha,beta,gama,lambda)+&
187 : & Phi3_333(alpha,beta,gama )*distance(iatom,katom,lambda+1)-&
188 8573904 : & Phi3_333(alpha,beta,lambda)*distance(iatom,katom,gama +1)
189 : end do
190 : end do
191 : end do
192 : end do
193 : end do !iatshell
194 : end do !ishell
195 : ! Check the acoustic sum rules (third order)
196 10160 : do ii=1,3
197 33020 : do jj=1,3
198 99060 : do kk=1,3
199 : ! Check the first acoustic sum rule
200 13386708 : do jatom=1,Invar%natom
201 13386708 : if (abs(asr3(1,jatom,ii,jj,kk)).gt.tol8) then
202 0 : write(std_out,'(a,1x,5(i3,1x),1(e17.10,1x))') '>>>>> WARNING (ASR3) --->',&
203 0 : & ii,jj,kk,iatom,jatom,asr3(1,jatom,ii,jj,kk)
204 0 : if (abs(asr3(1,jatom,ii,jj,kk)).gt.tol6)&
205 0 : & ABI_WARNING('The acoustic sum rule is not fulfilled (order 3, 3rd dim)')
206 : end if
207 : end do !jatom
208 : ! Check the second acoustic sum rule
209 13409568 : do katom=1,Invar%natom
210 13386708 : if (abs(asr3(2,katom,ii,jj,kk)).gt.tol8) then
211 0 : write(std_out,'(a,1x,5(i3,1x),1(e17.10,1x))') '>>>>> WARNING (ASR3) --->',&
212 0 : & ii,jj,kk,iatom,katom,asr3(2,katom,ii,jj,kk)
213 0 : if (abs(asr3(2,katom,ii,jj,kk)).gt.tol6)&
214 0 : & ABI_WARNING('The acoustic sum rule is not fulfilled (order 3, 2nd dim)')
215 : end if
216 : end do !jatom
217 : end do !kk
218 : end do !jj
219 : end do !ii
220 : ! Check the rotational invariance (third order)
221 495818 : do jatom=1,Invar%natom
222 1975596 : do alpha=1,3
223 6412432 : do beta=1,3
224 19237296 : do gama=1,3
225 57711888 : do lambda=1,3
226 53272512 : if (abs(rot3(jatom,alpha,beta,gama,lambda)).gt.tol8) then
227 0 : write(std_out,'(a,6(i3,1x),1(e17.10,1x))') '>>>>> WARNING (ROT3) ---> iatom,jatom,alpha,beta,gama,lambda,norm =',&
228 0 : & iatom,jatom,alpha,beta,gama,lambda,rot3(jatom,alpha,beta,gama,lambda)
229 0 : if (abs(rot3(jatom,alpha,beta,gama,lambda)).gt.tol6)&
230 0 : & ABI_WARNING('The invariance under arbitrary rotation is not fulfilled (order 3)')
231 : end if
232 : end do !lambda
233 : end do !gama
234 : end do !beta
235 : end do !alpha
236 : end do !jatom
237 : end do !iatom
238 14 : ABI_FREE(asr3)
239 14 : ABI_FREE(rot3)
240 : end if !order=3
241 :
242 : ! FOURTH ORDER
243 : if (order4) then
244 : !FB ABI_MALLOC(rot3,(Invar%natom,3,3,3,3)) ; rot3(:,:,:,:,:)=0.d0
245 : ABI_MALLOC(asr4,(Invar%natom,Invar%natom,3,3,3,3)) ; asr4(:,:,:,:,:,:)=0.d0
246 : do iatom=1,Invar%natom
247 : asr4(:,:,:,:,:,:)=0.d0
248 : !FB rot3(:,:,:,:,:)=0.d0
249 : !FB do jatom=1,Invar%natom
250 : !FB if (distance(iatom,jatom,1).gt.Invar%rcut3) cycle
251 : !FB! Compute the rotational invariance (third order)
252 : !FB do alpha=1,3
253 : !FB do beta=1,3
254 : !FB do gama=1,3
255 : !FB do lambda=1,3
256 : !FB rot3(jatom,alpha,beta,gama,lambda)=rot3(jatom,alpha,beta,gama,lambda)+&
257 : !FB& Model%Phi2%SR(3*(iatom-1)+gama ,3*(jatom-1)+beta )*Kroenecker(alpha,lambda)+&
258 : !FB& Model%Phi2%SR(3*(iatom-1)+alpha ,3*(jatom-1)+gama )*Kroenecker(beta,lambda)-&
259 : !FB& Model%Phi2%SR(3*(iatom-1)+lambda,3*(jatom-1)+beta )*Kroenecker(alpha,gama)-&
260 : !FB& Model%Phi2%SR(3*(iatom-1)+alpha ,3*(jatom-1)+lambda)*Kroenecker(beta,gama)
261 : !FB end do !lambda
262 : !FB end do !gama
263 : !FB end do !beta
264 : !FB end do !alpha
265 : !FB end do !jatom
266 : do ishell=1,Shell4at%nshell
267 : ! Build the 3x3x3x3 IFC of an atom in this shell
268 : if (Shell4at%neighbours(iatom,ishell)%n_interactions.eq.0) cycle
269 : do iatshell=1,Shell4at%neighbours(iatom,ishell)%n_interactions
270 : jatom=Shell4at%neighbours(iatom,ishell)%atomj_in_shell(iatshell)
271 : katom=Shell4at%neighbours(iatom,ishell)%atomk_in_shell(iatshell)
272 : latom=Shell4at%neighbours(iatom,ishell)%atoml_in_shell(iatshell)
273 : isym =Shell4at%neighbours(iatom,ishell)%sym_in_shell(iatshell)
274 : itrans=Shell4at%neighbours(iatom,ishell)%transpose_in_shell(iatshell)
275 : call tdep_build_phi4_3333(isym,Model%Phi4(:,:,:,:,ishell),Phi4_3333,Sym,itrans)
276 : ! Compute the first ASR : sum_l Phi3_ijkl=0
277 : asr4(jatom,katom,:,:,:,:)=asr4(jatom,katom,:,:,:,:)+Phi4_3333(:,:,:,:)
278 : !FB! Compute the rotational invariance (third order)
279 : !FB do alpha=1,3
280 : !FB do beta=1,3
281 : !FB do gama=1,3
282 : !FB do lambda=1,3
283 : !FB rot3(jatom,alpha,beta,gama,lambda)=rot3(jatom,alpha,beta,gama,lambda)+&
284 : !FB& Phi3_333(alpha,beta,gama )*distance(iatom,katom,lambda+1)-&
285 : !FB& Phi3_333(alpha,beta,lambda)*distance(iatom,katom,gama +1)
286 : !FB end do
287 : !FB end do
288 : !FB end do
289 : !FB end do
290 : end do !iatshell
291 : end do !ishell
292 : ! Check the acoustic sum rules (fourth order)
293 : do ii=1,3
294 : do jj=1,3
295 : do kk=1,3
296 : do ll=1,3
297 : do jatom=1,Invar%natom
298 : do katom=1,Invar%natom
299 : if (abs(asr4(jatom,katom,ii,jj,kk,ll)).gt.tol8) then
300 : write(std_out,'(a,1x,7(i3,1x),1(e17.10,1x))') '>>>>> WARNING (ASR4) --->',&
301 : & ii,jj,kk,ll,iatom,jatom,katom,asr4(jatom,katom,ii,jj,kk,ll)
302 : if (abs(asr4(jatom,katom,ii,jj,kk,ll)).gt.tol6)&
303 : & ABI_WARNING('The acoustic sum rule is not fulfilled (order 4)')
304 : end if
305 : end do !katom
306 : end do !jatom
307 : end do !ll
308 : end do !kk
309 : end do !jj
310 : end do !ii
311 : !FB! Check the rotational invariance (third order)
312 : !FB do jatom=1,Invar%natom
313 : !FB do alpha=1,3
314 : !FB do beta=1,3
315 : !FB do gama=1,3
316 : !FB do lambda=1,3
317 : !FB if (abs(rot3(jatom,alpha,beta,gama,lambda)).gt.tol8) then
318 : !FB write(std_out,'(a,6(i3,1x),1(e17.10,1x))') &
319 : !FB &'>>>>> WARNING (ROT3) ---> iatom,jatom,alpha,beta,gama,lambda,norm =',&
320 : !FB& iatom,jatom,alpha,beta,gama,lambda,rot3(jatom,alpha,beta,gama,lambda)
321 : !FB if (abs(rot3(jatom,alpha,beta,gama,lambda)).gt.tol6)&
322 : !FB& ABI_WARNING('The invariance under arbitrary rotation is not fulfilled (order 3)')
323 : !FB end if
324 : !FB end do !lambda
325 : !FB end do !gama
326 : !FB end do !beta
327 : !FB end do !alpha
328 : !FB end do !jatom
329 : end do !iatom
330 : ABI_FREE(asr4)
331 : !FB ABI_FREE(rot3)
332 : end if !order=4
333 :
334 44 : end subroutine tdep_check_constraints
335 :
336 : !=====================================================================================================
337 :
338 44 : subroutine tdep_print_Aknowledgments(unt)
339 :
340 : integer, intent(in) :: unt
341 :
342 44 : write(unt,*) ' '
343 44 : write(unt,'(a)') ' #############################################################################'
344 44 : write(unt,'(a)') ' ######################### CALCULATION COMPLETED #############################'
345 44 : write(unt,'(a)') ' #############################################################################'
346 44 : write(unt,'(a)') ' Suggested references for the acknowledgment of ABINIT usage.'
347 44 : write(unt,'(a)') ' '
348 44 : write(unt,'(a)') ' The users of ABINIT have little formal obligations with respect to the ABINIT group'
349 44 : write(unt,'(a)') ' (those specified in the GNU General Public License, http://www.gnu.org/copyleft/gpl.txt).'
350 44 : write(unt,'(a)') ' However, it is common practice in the scientific literature,'
351 44 : write(unt,'(a)') ' to acknowledge the efforts of people that have made the research possible.'
352 44 : write(unt,'(a)') ' In this spirit, please find below suggested citations of work written by ABINIT developers,'
353 44 : write(unt,'(a)') ' corresponding to implementations inside of ABINIT that you have used in the present run.'
354 44 : write(unt,'(a)') ' Note also that it will be of great value to readers of publications presenting these results,'
355 44 : write(unt,'(a)') ' to read papers enabling them to understand the theoretical formalism and details'
356 44 : write(unt,'(a)') ' of the ABINIT implementation.'
357 44 : write(unt,'(a)') ' For information on why they are suggested, see also https://docs.abinit.org/theory/acknowledgments.'
358 44 : write(unt,'(a)') ' '
359 44 : write(unt,'(a)') ' [1] a-TDEP: Temperature Dependent Effective Potential for Abinit '
360 44 : write(unt,'(a)') ' -- Lattice dynamic properties including anharmonicity'
361 44 : write(unt,'(a)') ' F. Bottin, J. Bieder and J. Bouchet, Comput. Phys. Comm. 254, 107301 (2020).' ! [[cite:Bottin2020]]
362 44 : write(unt,'(a)') ' Strong suggestion to cite this paper in your publications.'
363 44 : write(unt,'(a)') ' '
364 44 : write(unt,'(a)') ' [2] Thermal evolution of vibrational properties of alpha-U'
365 44 : write(unt,'(a)') ' J. Bouchet and F. Bottin, Phys. Rev. B 92, 174108 (2015).' ! [[cite:Bouchet2015]]
366 44 : write(unt,'(a)') ' Strong suggestion to cite this paper in your publications.'
367 44 : write(unt,'(a)') ' '
368 44 : write(unt,'(a)') ' [3] Lattice dynamics of anharmonic solids from first principles'
369 44 : write(unt,'(a)') ' O. Hellman, I.A. Abrikosov and S.I. Simak, Phys. Rev. B 84, 180301(R) (2011).' ! [[cite:Hellman2011]]
370 44 : write(unt,'(a)') ' '
371 44 : write(unt,'(a)') ' [4] Temperature dependent effective potential method for accurate free energy calculations of solids'
372 44 : write(unt,'(a)') ' O. Hellman, P. Steneteg, I.A. Abrikosov and S.I. Simak, Phys. Rev. B 87, 104111 (2013).' ! [[cite:Hellman2013]]
373 :
374 44 : end subroutine tdep_print_Aknowledgments
375 :
376 : !=====================================================================================================
377 :
378 : end module m_tdep_utils
|
