Branch data Line data Source code
1 : : !!****m* ABINIT/m_tdep_phi3
2 : : !! NAME
3 : : !! m_tdep_phi3
4 : : !!
5 : : !! FUNCTION
6 : : !! This module contains the routines building and writing the third-order IFC.
7 : : !!
8 : : !! COPYRIGHT
9 : : !! Copyright (C) 2011-2026 ABINIT group (GA,FB,JB)
10 : : !! This file is distributed under the terms of the
11 : : !! GNU General Public License, see ~abinit/COPYING
12 : : !! or http://www.gnu.org/copyleft/gpl.txt .
13 : : !!
14 : : !! SOURCE
15 : :
16 : : #if defined HAVE_CONFIG_H
17 : : #include "config.h"
18 : : #endif
19 : :
20 : : #include "abi_common.h"
21 : :
22 : : module m_tdep_phi3
23 : :
24 : : use defs_basis
25 : : use m_errors
26 : : use m_abicore
27 : : use m_numeric_tools
28 : : use m_linalg_interfaces
29 : : use m_xmpi
30 : : use m_io_tools
31 : : use m_tdep_shell, only : Shell_type
32 : : use m_tdep_sym, only : Symmetries_type
33 : : use m_tdep_supercell, only : tdep_Supercell_type
34 : :
35 : : implicit none
36 : : !!***
37 : :
38 : : public :: tdep_build_phi3_333
39 : : public :: tdep_write_phi3
40 : :
41 : : contains
42 : :
43 : : !=====================================================================================================
44 : :
45 : : !!****f* ABINIT/m_tdep_phi3/tdep_write_phi3
46 : : !! NAME
47 : : !! tdep_write_phi3
48 : : !!
49 : : !! FUNCTION
50 : : !! Write the third-order IFC in the output file: for each shell, the 3x3x3 IFC
51 : : !! of every triplet of atoms of the shell (built from the reference IFC of the
52 : : !! shell, see tdep_build_phi3_333), and the vectors between the three atoms.
53 : : !!
54 : : !! INPUTS
55 : : !! Phi3_ref(3,3,3,nshell) = Third-order IFC for the reference triplet of each shell.
56 : : !! SC = Supercell object, used for the interatomic distances (SC%dij).
57 : : !! Shell3at = Shell object for third-order interactions.
58 : : !! Sym = Symmetries object describing all the symmetry operations of the crystal.
59 : : !!
60 : : !! OUTPUT
61 : : !! Only writing.
62 : : !!
63 : : !! SOURCE
64 : :
65 : 16 : subroutine tdep_write_phi3(Phi3_ref,SC,Shell3at,Sym)
66 : :
67 : : type(tdep_Supercell_type),intent(in) :: SC
68 : : type(Shell_type),intent(in) :: Shell3at
69 : : type(Symmetries_type),intent(in) :: Sym
70 : : real(dp), intent(in) :: Phi3_ref(3,3,3,Shell3at%nshell)
71 : :
72 : : integer :: ishell,isym,jatom,katom
73 : : integer :: iatref,jatref,katref,iatshell,itrans
74 : : integer :: ii,jj
75 : : double precision :: tmp1,tmp2,tmp3
76 : 16 : double precision, allocatable :: Phi3_333(:,:,:)
77 : :
78 : 16 : write(ab_out,*) ' '
79 : 16 : write(ab_out,*) '#############################################################################'
80 : 16 : write(ab_out,*) '#### For each shell, list of coefficients (IFC), number of neighbours... ####'
81 : 16 : write(ab_out,*) '#############################################################################'
82 : :
83 : : ! Write the IFCs in the data.out file (with others specifications:
84 : : ! number of atoms in a shell, Trace...)
85 [ + - + + : 656 : ABI_MALLOC(Phi3_333,(3,3,3)) ; Phi3_333(:,:,:)=0.d0
+ + + + ]
86 [ + + ]: 73 : do ishell=1,Shell3at%nshell
87 : 57 : iatref=Shell3at%iatref(ishell)
88 [ + - ]: 73 : if (Shell3at%neighbours(iatref,ishell)%n_interactions.ne.0) then
89 : 57 : jatref=Shell3at%jatref(ishell)
90 : 57 : katref=Shell3at%katref(ishell)
91 : 57 : write(ab_out,'(a,i4,a,i4,a)') ' ======== NEW SHELL (ishell=',ishell,&
92 : 114 : & '): There are',Shell3at%neighbours(iatref,ishell)%n_interactions,' atoms on this shell'
93 [ + + ]: 732 : do iatshell=1,Shell3at%neighbours(iatref,ishell)%n_interactions
94 : 675 : jatom=Shell3at%neighbours(iatref,ishell)%atomj_in_shell(iatshell)
95 : 675 : katom=Shell3at%neighbours(iatref,ishell)%atomk_in_shell(iatshell)
96 : 675 : isym =Shell3at%neighbours(iatref,ishell)%sym_in_shell(iatshell)
97 : 675 : itrans=Shell3at%neighbours(iatref,ishell)%transpose_in_shell(iatshell)
98 : 675 : call tdep_build_phi3_333(isym,Phi3_ref(:,:,:,ishell),Phi3_333,Sym,itrans)
99 : 675 : write(ab_out,'(a,i4,a,i4)') ' For iatcell=',iatref,' ,with type=',mod(iatref-1,SC%natom_unitcell)+1
100 : 675 : write(ab_out,'(a,i4,a,i4)') ' For jatom =',jatom ,' ,with type=',mod(jatom -1,SC%natom_unitcell)+1
101 : 675 : write(ab_out,'(a,i4,a,i4)') ' For katom =',katom ,' ,with type=',mod(katom -1,SC%natom_unitcell)+1
102 [ + + ]: 2700 : do jj=1,3
103 [ + + ]: 2025 : if (jj==1) write(ab_out,'(a)') ' Phi3^{alpha beta x}='
104 [ + + ]: 2025 : if (jj==2) write(ab_out,'(a)') ' Phi3^{alpha beta y}='
105 [ + + ]: 2025 : if (jj==3) write(ab_out,'(a)') ' Phi3^{alpha beta z}='
106 [ + + ]: 8775 : do ii=1,3
107 [ + + ]: 6075 : if (abs(Phi3_333(ii,1,jj)).lt.5.d-7) then
108 : 1647 : tmp1=0.d0
109 : : else
110 : 4428 : tmp1=Phi3_333(ii,1,jj)
111 : : end if
112 [ + + ]: 6075 : if (abs(Phi3_333(ii,2,jj)).lt.5.d-7) then
113 : 1587 : tmp2=0.d0
114 : : else
115 : 4488 : tmp2=Phi3_333(ii,2,jj)
116 : : end if
117 [ + + ]: 6075 : if (abs(Phi3_333(ii,3,jj)).lt.5.d-7) then
118 : 1651 : tmp3=0.d0
119 : : else
120 : 4424 : tmp3=Phi3_333(ii,3,jj)
121 : : end if
122 : 8100 : write(ab_out,'(2x,3(f9.6,1x))') tmp1,tmp2,tmp3
123 : : end do
124 : : end do
125 [ + - + + ]: 2700 : write(ab_out,'(a,3(f9.6,1x))') ' (i,j) vector components:', (SC%dij(iatref,jatom,jj+1),jj=1,3)
126 [ + - + + ]: 2700 : write(ab_out,'(a,3(f9.6,1x))') ' (j,k) vector components:', (SC%dij(jatom ,katom,jj+1),jj=1,3)
127 [ + - + + ]: 2700 : write(ab_out,'(a,3(f9.6,1x))') ' (k,i) vector components:', (SC%dij(katom,iatref,jj+1),jj=1,3)
128 : 732 : write(ab_out,*) ' '
129 : : end do !iatshell
130 : : end if !n_interactions
131 : : end do !ishell
132 [ - + ]: 16 : ABI_FREE(Phi3_333)
133 : :
134 : 16 : end subroutine tdep_write_phi3
135 : : !!***
136 : :
137 : : !=====================================================================================================
138 : :
139 : : !!****f* ABINIT/m_tdep_phi3/tdep_build_phi3_333
140 : : !! NAME
141 : : !! tdep_build_phi3_333
142 : : !!
143 : : !! FUNCTION
144 : : !! Build the 3x3x3 third-order IFC of one atom triplet in a shell, from the
145 : : !! shell's reference IFC, a symmetry operation and a permutation index.
146 : : !! The symmetry operation S is applied to each of the three cartesian
147 : : !! indices of the reference IFC, then the indices are permuted according
148 : : !! to itrans.
149 : : !!
150 : : !! INPUTS
151 : : !! isym = Index of the symmetry operation.
152 : : !! Phi3_ref(3,3,3) = Third-order IFC of the reference triplet of the shell.
153 : : !! Sym = Symmetries object describing all the symmetry operations of the crystal.
154 : : !! itrans = Index of the permutation of the three atoms (1 to 6):
155 : : !! 1=efg, 2=egf, 3=feg, 4=fge, 5=gef, 6=gfe.
156 : : !!
157 : : !! OUTPUT
158 : : !! Phi3_333(3,3,3) = Third-order IFC of the triplet.
159 : : !!
160 : : !! SOURCE
161 : :
162 : 508592 : subroutine tdep_build_phi3_333(isym,Phi3_ref,Phi3_333,Sym,itrans)
163 : :
164 : : type(Symmetries_type),intent(in) :: Sym
165 : : double precision, intent(in) :: Phi3_ref(3,3,3)
166 : : double precision, intent(out) :: Phi3_333(3,3,3)
167 : : integer,intent(in) :: isym,itrans
168 : :
169 : : integer :: alpha,beta,gama
170 : : integer :: ii,jj,kk,ee,ff,gg,mu,nu,xi
171 : : double precision :: Phi3_tmp(3,3,3)
172 : :
173 : :
174 : : ! Transform in the new basis wrt S_ref
175 : 508592 : Phi3_333(:,:,:)=zero
176 [ + + ]: 2034368 : do mu=1,3
177 [ + + ]: 6611696 : do alpha=1,3
178 [ + + ]: 19835088 : do nu=1,3
179 [ + + ]: 59505264 : do beta=1,3
180 [ + + ]: 178515792 : do xi=1,3
181 [ + + ]: 535547376 : do gama=1,3
182 : : Phi3_333(mu,nu,xi)=Phi3_333(mu,nu,xi)+&
183 : 494351424 : & Sym%S_ref(mu,alpha,isym,1)*Sym%S_ref(nu,beta,isym,1)*Sym%S_ref(xi,gama,isym,1)*Phi3_ref(alpha,beta,gama)
184 : : end do
185 : : end do
186 : : end do
187 : : end do
188 : : end do
189 : : end do
190 : :
191 : : ! Take into account the 6 allowed permutations
192 : 508592 : Phi3_tmp(:,:,:)=Phi3_333(:,:,:)
193 [ - + ]: 508592 : if ((itrans.lt.1).or.(itrans.gt.6)) then
194 : 0 : ABI_BUG('This value of the symmetry index is not permitted')
195 : : end if
196 [ + + ]: 2034368 : do ii=1,3
197 [ + + ]: 6611696 : do jj=1,3
198 [ + + ]: 19835088 : do kk=1,3
199 [ + + ]: 13731984 : if (itrans==1) then ; ee=ii ; ff=jj ; gg=kk ; endif !\Phi3_efg
200 [ + + ]: 13731984 : if (itrans==2) then ; ee=ii ; ff=kk ; gg=jj ; endif !\Phi3_egf
201 [ + + ]: 13731984 : if (itrans==3) then ; ee=jj ; ff=ii ; gg=kk ; endif !\Phi3_feg
202 [ + + ]: 13731984 : if (itrans==4) then ; ee=jj ; ff=kk ; gg=ii ; endif !\Phi3_fge
203 [ + + ]: 13731984 : if (itrans==5) then ; ee=kk ; ff=ii ; gg=jj ; endif !\Phi3_gef
204 [ + + ]: 13731984 : if (itrans==6) then ; ee=kk ; ff=jj ; gg=ii ; endif !\Phi3_gfe
205 : 18309312 : Phi3_333(ee,ff,gg)=Phi3_tmp(ii,jj,kk)
206 : : end do
207 : : end do
208 : : end do
209 : :
210 : 508592 : end subroutine tdep_build_phi3_333
211 : : !!***
212 : :
213 : : !=====================================================================================================
214 : :
215 : : end module m_tdep_phi3
216 : : !!***
|
