Line data Source code
1 : !!****f* ABINIT/m_polynomial_conf
2 : !!
3 : !! NAME
4 : !! m_polynomial_conf
5 : !!
6 : !! FUNCTION
7 : !! Module for using a confinement potential
8 : !! Container type is defined, and destruction
9 : !!
10 : !! COPYRIGHT
11 : !! Copyright (C) 2010-2026 ABINIT group (AM)
12 : !! This file is distributed under the terms of the
13 : !! GNU General Public Licence, see ~abinit/COPYING
14 : !! or http://www.gnu.org/copyleft/gpl.txt .
15 : !! For the initials of contributors, see ~abinit/doc/developers/contributors.txt .
16 : !!
17 : !! SOURCE
18 :
19 :
20 : #if defined HAVE_CONFIG_H
21 : #include "config.h"
22 : #endif
23 :
24 : #include "abi_common.h"
25 :
26 : module m_polynomial_conf
27 :
28 : use defs_basis
29 : use m_errors
30 : use m_abicore
31 : use m_xmpi,only : xmpi_sum
32 :
33 : implicit none
34 :
35 : public :: polynomial_conf_init
36 : public :: polynomial_conf_free
37 : !AM_2017Need to debug this routine
38 : public :: polynomial_conf_evaluate
39 : !!***
40 :
41 : !!****t* m_polynomial_conf/polynomial_conf_type
42 : !! NAME
43 : !! polynomial_conf_type
44 : !!
45 : !! FUNCTION
46 : !! datatype for specific confinement potential
47 : !!
48 : !! SOURCE
49 :
50 : type, public :: polynomial_conf_type
51 :
52 : integer :: ndisp = 0
53 : ! Number of displacement (atoms) for the cut off
54 :
55 : integer :: power_disp = 0
56 : ! Power of the polynome related to the displacement
57 :
58 : integer :: power_strain = 0
59 : ! Power of the polynome related to the strain
60 :
61 : real(dp):: factor_disp = 0
62 : ! Factor to appy to the polynomial term of the confinement (displacement)
63 :
64 : real(dp):: factor_strain = 0
65 : ! Factor to appy to the polynomial term of the confinement (strain)
66 :
67 : real(dp):: cutoff_strain(6)
68 : ! Cutoff array for the strain
69 :
70 : real(dp),allocatable :: cutoff_disp(:)
71 : ! Cutoff array for the atomic displacement
72 :
73 : logical :: need_confinement =.FALSE.
74 : ! Logical related to the necessity of the confinement
75 :
76 : end type polynomial_conf_type
77 : !!***
78 :
79 :
80 : CONTAINS !===========================================================================================
81 :
82 :
83 : !!****f* m_polynomial_conf/polynomial_conf_init
84 : !!
85 : !! NAME
86 : !! polynomial_conf_init
87 : !!
88 : !! FUNCTION
89 : !! Initialize polynomial_conf_init
90 : !!
91 : !! INPUTS
92 : !! cutoff_disp(6) = Cutoff array for the strain
93 : !! cutoff_strain(ndisp) = Cutoff array for the atomic displacement
94 : !! factor_disp = Factor to appy to the polynomial term of the confinement (displacement)
95 : !! factor_strain = Factor to appy to the polynomial term of the confinement (strain)
96 : !! ndisp = Number of displacement (atoms) for the cut off
97 : !! power_disp = Power of the polynome related to the displacement
98 : !! power_strain = Power of the polynome related to the strain
99 : !! need_confinement = optional,Logical related to the necessity of the confinement
100 : !!
101 : !! OUTPUT
102 : !! polynomial_conf <type(polynomial_conf)> = datatype with the information for the confinement
103 : !! polynomial
104 : !!
105 : !! SOURCE
106 : !!
107 :
108 0 : subroutine polynomial_conf_init(cutoff_disp,cutoff_strain,factor_disp,factor_strain,ndisp,&
109 : & polynomial_conf,power_disp,power_strain,need_confinement)
110 :
111 : implicit none
112 :
113 : !Arguments ------------------------------------
114 : !scalars
115 : integer, intent(in) :: ndisp,power_disp,power_strain
116 : real(dp),intent(in) :: factor_disp,factor_strain
117 : logical,optional,intent(in) :: need_confinement
118 : !arrays
119 : real(dp),intent(in) :: cutoff_disp(ndisp),cutoff_strain(6)
120 : type(polynomial_conf_type),intent(inout) :: polynomial_conf
121 : !Local variables-------------------------------
122 : !scalar
123 : !arrays
124 : character(len=500) :: msg
125 :
126 : ! *************************************************************************
127 :
128 : !Checks
129 0 : if (ndisp <= 0) then
130 0 : write(msg,'(a,a)')' ndisp can not be inferior or equal to zero'
131 0 : ABI_ERROR(msg)
132 : end if
133 :
134 : !First free the type
135 0 : call polynomial_conf_free(polynomial_conf)
136 :
137 0 : polynomial_conf%power_disp = power_disp
138 0 : polynomial_conf%power_strain = power_strain
139 0 : polynomial_conf%factor_disp = factor_disp
140 0 : polynomial_conf%factor_strain = factor_strain
141 0 : polynomial_conf%need_confinement = .FALSE.
142 :
143 0 : polynomial_conf%ndisp = ndisp
144 0 : ABI_MALLOC(polynomial_conf%cutoff_disp,(polynomial_conf%ndisp))
145 0 : polynomial_conf%cutoff_disp(:) = cutoff_disp(:)
146 :
147 0 : polynomial_conf%cutoff_strain = cutoff_strain(:)
148 0 : if (present(need_confinement)) polynomial_conf%need_confinement = need_confinement
149 :
150 0 : end subroutine polynomial_conf_init
151 : !!***
152 :
153 :
154 : !!****f* m_polynomial_conf/polynomial_conf_free
155 : !!
156 : !! NAME
157 : !! polynomial_conf_free
158 : !!
159 : !! FUNCTION
160 : !! Free polynomial_conf
161 : !!
162 : !! INPUTS
163 : !! polynomial_conf <type(polynomial_conf)> = polynomial_conf datatype to be free
164 : !!
165 : !! OUTPUT
166 : !! polynomial_conf <type(polynomial_conf)> = polynomial_conf datatype to be free
167 : !!
168 : !! SOURCE
169 :
170 534 : subroutine polynomial_conf_free(polynomial_conf)
171 :
172 : implicit none
173 :
174 : !Arguments ------------------------------------
175 : !scalars
176 : !arrays
177 : type(polynomial_conf_type), intent(inout) :: polynomial_conf
178 : !Local variables-------------------------------
179 : !scalar
180 : !arrays
181 :
182 : ! *************************************************************************
183 :
184 534 : if(allocated(polynomial_conf%cutoff_disp))then
185 0 : ABI_SFREE(polynomial_conf%cutoff_disp)
186 : end if
187 :
188 534 : polynomial_conf%power_disp = 0
189 534 : polynomial_conf%power_strain = 0
190 534 : polynomial_conf%factor_disp = zero
191 534 : polynomial_conf%factor_strain = zero
192 3738 : polynomial_conf%cutoff_strain = zero
193 534 : polynomial_conf%need_confinement = .FALSE.
194 :
195 534 : end subroutine polynomial_conf_free
196 : !!***
197 :
198 : !!****f* m_polynomial_conf/polynomial_conf_evaluate
199 : !! NAME
200 : !! polynomial_conf_evaluate
201 : !!
202 : !! FUNCTION
203 : !! This fonction evaluate the energy, (soon forces and stresses) with the confinement potential
204 : !!
205 : !! INPUTS
206 : !! disp(3,natom_sc) = atomic displacments of a specific patern wrt to reference structure
207 : !! disp_ref(natom_uc) = Cutoff array for the atomic displacement
208 : !! factor_disp = Factor to appy to the polynomial term of the confinement (displacement)
209 : !! factor_strain = Factor to appy to the polynomial term of the confinement (strain)
210 : !! strain(6) = strain of a specific structure wrt to reference
211 : !! strain_ref(6) = Cutoff array for the strain
212 : !! power_disp = Power of the polynome related to the displacement
213 : !! power_strain = Power of the polynome related to the strain
214 : !! natom_sc = number of atoms in the supercell
215 : !! natom_uc = number of atoms in the unit cell
216 : !! ncell = total number of cell to treat by this cpu
217 : !! cells(ncell) = index of the cells into the supercell (1,2,3,4,5)
218 : !! index_cells(3,ncell) = indexes of the cells into supercell (-1 -1 -1 ,...,1 1 1)
219 : !! comm=MPI communicator
220 : !!
221 : !! OUTPUT
222 : !! energy = contribution to the ifc to the energy
223 : !! fcart(3,natom) = contribution to the ifc to the forces
224 : !! strten(6) = contribution to the stress tensor
225 : !!
226 : !! SOURCE
227 :
228 0 : subroutine polynomial_conf_evaluate(disp,disp_ref,energy,factor_disp,factor_strain,fcart,&
229 0 : & strain,strain_ref,strten,power_disp,power_strain,cells,&
230 0 : & natom_sc,natom_uc,ncell,index_cells,comm)
231 :
232 : implicit none
233 :
234 : !Arguments -------------------------------
235 : ! scalars
236 : real(dp),intent(out) :: energy
237 : integer,intent(in) :: natom_uc,natom_sc,ncell
238 : integer,intent(in) :: power_disp,power_strain
239 : integer,intent(in) :: comm
240 : real(dp),intent(in) :: factor_disp,factor_strain
241 : ! array
242 : integer,intent(in) :: cells(ncell),index_cells(ncell,3)
243 : real(dp),intent(in) :: disp(3,natom_sc),strain(6)
244 : real(dp),intent(out) :: fcart(3,natom_sc),strten(6)
245 : real(dp),intent(in) :: disp_ref(natom_uc),strain_ref(6)
246 : !Local variables-------------------------------
247 : ! scalar
248 : integer :: ia,icell,ierr,ii,kk
249 : integer :: mu
250 : real(dp):: diff,diff_tmp
251 : ! array
252 :
253 : ! *************************************************************************
254 :
255 : ! Initialisation of variables
256 0 : energy = zero
257 0 : fcart(:,:) = zero
258 0 : strten(:) = zero
259 :
260 0 : write(std_out,*) factor_strain,index_cells,power_strain,strain,strain_ref
261 0 : do icell = 1,ncell
262 0 : ii = (cells(icell)-1)*natom_uc
263 0 : do ia = 1, natom_uc
264 0 : kk = ii + ia
265 0 : diff_tmp = zero
266 0 : do mu=1,3
267 0 : diff_tmp = diff_tmp + disp(mu,kk)**2
268 : end do
269 0 : diff_tmp = diff_tmp**0.5
270 : ! Compute diff between ref and curent displacement
271 0 : diff = diff_tmp - disp_ref(ia)
272 : ! Accumule energy
273 0 : energy = energy + (sign(half, diff)+half)*(factor_disp*((diff_tmp/disp_ref(ia))**power_disp))
274 : end do
275 : end do
276 :
277 : ! MPI_SUM
278 0 : call xmpi_sum(energy, comm, ierr)
279 :
280 0 : end subroutine polynomial_conf_evaluate
281 : !!***
282 :
283 0 : end module m_polynomial_conf
284 : !!***
|
