TABLE OF CONTENTS


ABINIT/m_polynomial_conf [ Functions ]

[ Top ] [ Functions ]

NAME

 m_polynomial_conf

FUNCTION

 Module for using a confinement potential
 Container type is defined, and destruction

COPYRIGHT

 Copyright (C) 2010-2022 ABINIT group (AM)
 This file is distributed under the terms of the
 GNU General Public Licence, see ~abinit/COPYING
 or http://www.gnu.org/copyleft/gpl.txt .
 For the initials of contributors, see ~abinit/doc/developers/contributors.txt .

SOURCE

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

m_polynomial_conf/polynomial_conf_evaluate [ Functions ]

[ Top ] [ m_polynomial_conf ] [ Functions ]

NAME

  polynomial_conf_evaluate

FUNCTION

  This fonction evaluate the energy, (soon forces and stresses) with  the confinement potential

INPUTS

   disp(3,natom_sc) = atomic displacments of a specific patern wrt to reference structure
   disp_ref(natom_uc) = Cutoff array for the atomic displacement
   factor_disp = Factor to appy to the polynomial term of the confinement (displacement)
   factor_strain = Factor to appy to the polynomial term of the confinement (strain)
   strain(6) =   strain of a specific structure wrt to reference
   strain_ref(6) = Cutoff array for the strain
   power_disp = Power of the polynome related to the displacement
   power_strain = Power of the polynome related to the strain
   natom_sc = number of atoms in the supercell
   natom_uc = number of atoms in the unit cell
   ncell   = total number of cell to treat by this cpu
   cells(ncell) = index of  the cells into the supercell (1,2,3,4,5)
   index_cells(3,ncell) = indexes  of the cells into supercell (-1 -1 -1 ,...,1 1 1)
   comm=MPI communicator

OUTPUT

   energy = contribution to the ifc to the energy
   fcart(3,natom) = contribution to the ifc to the forces
   strten(6) = contribution to the stress tensor

SOURCE

228 subroutine polynomial_conf_evaluate(disp,disp_ref,energy,factor_disp,factor_strain,fcart,&
229 &                                   strain,strain_ref,strten,power_disp,power_strain,cells,&
230 &                                   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   energy   = zero
257   fcart(:,:) = zero
258   strten(:) = zero
259 
260   write(std_out,*) factor_strain,index_cells,power_strain,strain,strain_ref
261   do icell = 1,ncell
262     ii = (cells(icell)-1)*natom_uc
263     do ia = 1, natom_uc
264       kk = ii + ia
265       diff_tmp = zero
266       do mu=1,3
267         diff_tmp = diff_tmp + disp(mu,kk)**2
268       end do
269       diff_tmp = diff_tmp**0.5
270 !     Compute diff between ref and curent displacement
271       diff = diff_tmp - disp_ref(ia)
272 !     Accumule energy
273       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   call xmpi_sum(energy, comm, ierr)
279 
280 end subroutine polynomial_conf_evaluate

m_polynomial_conf/polynomial_conf_free [ Functions ]

[ Top ] [ m_polynomial_conf ] [ Functions ]

NAME

 polynomial_conf_free

FUNCTION

 Free polynomial_conf

INPUTS

 polynomial_conf <type(polynomial_conf)> = polynomial_conf datatype to be free

OUTPUT

 polynomial_conf <type(polynomial_conf)> = polynomial_conf datatype to be free

SOURCE

170 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  if(allocated(polynomial_conf%cutoff_disp))then
185    ABI_FREE(polynomial_conf%cutoff_disp)
186  end if
187 
188  polynomial_conf%power_disp    = 0
189  polynomial_conf%power_strain  = 0
190  polynomial_conf%factor_disp   = zero
191  polynomial_conf%factor_strain = zero
192  polynomial_conf%cutoff_strain = zero
193  polynomial_conf%need_confinement = .FALSE.
194 
195 end subroutine polynomial_conf_free

m_polynomial_conf/polynomial_conf_init [ Functions ]

[ Top ] [ m_polynomial_conf ] [ Functions ]

NAME

 polynomial_conf_init

FUNCTION

 Initialize polynomial_conf_init

INPUTS

 cutoff_disp(6) = Cutoff array for the strain
 cutoff_strain(ndisp) = Cutoff array for the atomic displacement
 factor_disp = Factor to appy to the polynomial term of the confinement (displacement)
 factor_strain = Factor to appy to the polynomial term of the confinement (strain)
 ndisp = Number of displacement (atoms) for the cut off
 power_disp = Power of the polynome related to the displacement
 power_strain = Power of the polynome related to the strain
 need_confinement = optional,Logical related to the necessity of the confinement

OUTPUT

 polynomial_conf <type(polynomial_conf)> = datatype with the information for the confinement
                                           polynomial

SOURCE

108 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  if (ndisp <= 0) then
130    write(msg,'(a,a)')' ndisp can not be inferior or equal to zero'
131    ABI_ERROR(msg)
132  end if
133 
134 !First free the type
135  call  polynomial_conf_free(polynomial_conf)
136 
137  polynomial_conf%power_disp    = power_disp
138  polynomial_conf%power_strain  = power_strain
139  polynomial_conf%factor_disp   = factor_disp
140  polynomial_conf%factor_strain = factor_strain
141  polynomial_conf%need_confinement = .FALSE.
142 
143  polynomial_conf%ndisp   = ndisp
144  ABI_MALLOC(polynomial_conf%cutoff_disp,(polynomial_conf%ndisp))
145  polynomial_conf%cutoff_disp(:) = cutoff_disp(:)
146 
147  polynomial_conf%cutoff_strain = cutoff_strain(:)
148  if (present(need_confinement)) polynomial_conf%need_confinement = need_confinement
149 
150 end subroutine polynomial_conf_init

m_polynomial_conf/polynomial_conf_type [ Types ]

[ Top ] [ m_polynomial_conf ] [ Types ]

NAME

 polynomial_conf_type

FUNCTION

 datatype for specific confinement potential

SOURCE

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