Line data Source code
1 : !!****m* ABINIT/m_lattice_harmonic_potential
2 : !! NAME
3 : !! m_lattice_harmonic_potential
4 : !!
5 : !! FUNCTION
6 : !! This module contains an harmonic lattice potential.
7 : !!
8 : !! Datatypes:
9 : !!
10 : !! Subroutines:
11 : !! TODO: add this when F2003 doc style is determined.
12 : !!
13 : !!
14 : !! COPYRIGHT
15 : !! Copyright (C) 2001-2026 ABINIT group (hexu)
16 : !! This file is distributed under the terms of the
17 : !! GNU General Public License, see ~abinit/COPYING
18 : !! or http://www.gnu.org/copyleft/gpl.txt .
19 : !! For the initials of contributors, see ~abinit/doc/developers/contributors.txt .
20 : !!
21 : !! SOURCE
22 :
23 :
24 : #if defined HAVE_CONFIG_H
25 : #include "config.h"
26 : #endif
27 :
28 : #include "abi_common.h"
29 :
30 :
31 : module m_lattice_harmonic_potential
32 : use defs_basis
33 : use m_errors
34 : use m_abicore
35 : use m_abstract_potential, only: abstract_potential_t
36 : use m_spmat_coo, only: COO_mat_t
37 : use m_multibinit_cell, only: mbcell_t, mbsupercell_t
38 : use m_hashtable_strval, only: hash_table_t
39 : implicit none
40 : !!***
41 :
42 : private
43 :
44 : type, public, extends(abstract_potential_t) :: lattice_harmonic_potential_t
45 : integer :: natom ! number of atoms
46 : real(dp) :: ref_energy=0.0 ! reference energy
47 : !real(dp):: ref_cell(3,3) ! reference structure cell parameters.Not needed.
48 : !real(dp), allocatable :: ref_xcart(:,:) ! reference xcart. not needed
49 : type(COO_mat_t) :: coeff ! coefficient. A COO sparse matrix (3N*3N).
50 : contains
51 : procedure :: initialize
52 : procedure :: finalize
53 : procedure :: set_supercell
54 : procedure :: set_ref_energy
55 : procedure :: calculate
56 : procedure :: add_term
57 : end type lattice_harmonic_potential_t
58 :
59 : contains
60 :
61 :
62 : !-------------------------------------------------------------------!
63 : ! initialize
64 : ! Input:
65 : ! natom: number of atoms
66 : !-------------------------------------------------------------------!
67 5 : subroutine initialize(self, natom)
68 : class(lattice_harmonic_potential_t), intent(inout) :: self
69 : integer, intent(in) :: natom
70 5 : self%has_displacement = .True.
71 5 : self%is_null = .False.
72 5 : self%label="Lattice_harmonic_potential"
73 5 : self%natom=natom
74 15 : call self%coeff%initialize(mshape= [3*self%natom, 3*self%natom])
75 : !ABI_MALLOC(self%ref_xcart, (3, self%natom))
76 5 : end subroutine initialize
77 :
78 : !-------------------------------------------------------------------!
79 : ! Finalize
80 : !-------------------------------------------------------------------!
81 5 : subroutine finalize(self)
82 : class(lattice_harmonic_potential_t), intent(inout) :: self
83 5 : self%has_displacement=.False.
84 5 : call self%coeff%finalize()
85 5 : call self%abstract_potential_t%finalize()
86 5 : self%is_null=.True.
87 5 : self%natom=0
88 5 : end subroutine finalize
89 :
90 : !-------------------------------------------------------------------!
91 : ! Add a term to the potential
92 : !-------------------------------------------------------------------!
93 531744 : subroutine add_term(self, i,j, val)
94 : class(lattice_harmonic_potential_t), intent(inout) :: self
95 : integer, intent(in) :: i, j
96 : real(dp), intent(in) :: val
97 1595232 : call self%coeff%add_entry([i,j], val)
98 531744 : end subroutine add_term
99 :
100 :
101 : !-------------------------------------------------------------------!
102 : ! Set the reference energy.
103 : !-------------------------------------------------------------------!
104 5 : subroutine set_ref_energy(self, ref_energy)
105 : class(lattice_harmonic_potential_t), intent(inout) :: self
106 : real(dp), intent(in) :: ref_energy
107 5 : self%ref_energy=ref_energy
108 5 : end subroutine set_ref_energy
109 :
110 : !-------------------------------------------------------------------!
111 : ! set_supercell
112 : ! link the supercell with potential.
113 : ! Inputs:
114 : ! supercell: mbsupercell_t
115 : !-------------------------------------------------------------------!
116 10 : subroutine set_supercell(self, supercell)
117 : class(lattice_harmonic_potential_t), intent(inout) :: self
118 : type(mbsupercell_t), target, intent(inout) :: supercell
119 10 : self%supercell => supercell
120 10 : end subroutine set_supercell
121 :
122 :
123 : !-------------------------------------------------------------------!
124 : ! calculate force and energy from harmonic potential
125 : ! F= - IFC .matmul. displacement
126 : ! E = 1/2 (-F) .dot. displacement = 1/2<disp|IFC|disp>
127 : ! Input:
128 : ! displacement: required.
129 : !-------------------------------------------------------------------!
130 12028 : subroutine calculate(self, displacement, strain, spin, lwf, force, stress, bfield, lwf_force, energy, energy_table)
131 : ! This function calculate the energy and its first derivative
132 : ! the inputs and outputs are optional so that each effpot can adapt to its
133 : ! own.
134 : ! In principle, the 1st derivatives are only calculated if asked to (present). However, they can be computed if it is simply convinient to do.
135 : class(lattice_harmonic_potential_t), intent(inout) :: self ! the effpot may save the states.
136 :
137 : real(dp), optional, intent(inout) :: displacement(:,:), strain(:,:), spin(:,:), lwf(:)
138 : real(dp), optional, intent(inout) :: force(:,:), stress(:,:), bfield(:,:), lwf_force(:), energy
139 : type(hash_table_t),optional, intent(inout) :: energy_table
140 : real(dp) :: etmp
141 24056 : real(dp) :: f(3,self%natom)
142 : ! if present in input
143 : ! calculate if required
144 12028 : ABI_UNUSED_A(strain)
145 12028 : ABI_UNUSED_A(spin)
146 12028 : ABI_UNUSED_A(lwf)
147 12028 : ABI_UNUSED_A(stress)
148 12028 : ABI_UNUSED_A(bfield)
149 12028 : ABI_UNUSED_A(lwf_force)
150 :
151 12028 : etmp=0.0_dp
152 :
153 12028 : call self%coeff%mv(displacement, f)
154 12028 : if (present(force)) then
155 34610904 : force(:,:) = force(:,:) - f
156 : endif
157 :
158 : !energy =energy + 0.5_dp * sum(f*displacement)
159 51912188 : etmp=0.5_dp * sum(f*displacement)
160 12028 : if (present(energy)) then
161 12028 : energy=energy+etmp
162 : endif
163 12028 : if(present(energy_table)) then
164 12028 : call energy_table%put(self%label, etmp)
165 : endif
166 12028 : end subroutine calculate
167 :
168 15 : end module m_lattice_harmonic_potential
|