Branch data Line data Source code
1 : : !!****m* ABINIT/m_frskerker2
2 : : !! NAME
3 : : !! m_frskerker2
4 : : !!
5 : : !! FUNCTION
6 : : !! provide the ability to compute the
7 : : !! penalty function and its first derivative associated
8 : : !! with some residuals and a real space dielectric function
9 : : !!
10 : : !! COPYRIGHT
11 : : !! Copyright (C) 1998-2026 ABINIT group (DCA, XG, MT)
12 : : !! This file is distributed under the terms of the
13 : : !! GNU General Public License, see ~ABINIT/COPYING
14 : : !! or http://www.gnu.org/copyleft/gpl.txt .
15 : : !! For the initials of contributors, see ~ABINIT/Infos/contributors .
16 : : !!
17 : : !! NOTES
18 : : !! this is neither a function nor a subroutine. This is a module
19 : : !! It is made of two functions and one init subroutine
20 : : !!
21 : : !! SOURCE
22 : :
23 : : #if defined HAVE_CONFIG_H
24 : : #include "config.h"
25 : : #endif
26 : :
27 : : #include "abi_common.h"
28 : :
29 : : module m_frskerker2
30 : :
31 : : use defs_basis
32 : : use m_abicore
33 : : use m_dtset
34 : :
35 : : use defs_abitypes, only : MPI_type
36 : : use m_spacepar, only : laplacian
37 : : use m_numeric_tools, only : dotproduct
38 : :
39 : : implicit none
40 : :
41 : : !! common variables copied from input
42 : : integer,save,private :: nfft,nspden,ngfft(18)
43 : : real(dp),save,allocatable,private :: deltaW(:,:),mat(:,:),rdielng(:)
44 : : real(dp),save,private :: gprimd(3,3)
45 : : type(dataset_type),pointer,save,private :: dtset_ptr
46 : : type(MPI_type),pointer,save,private :: mpi_enreg_ptr
47 : : !! common variables computed
48 : : logical,save,private :: ok=.false.
49 : : ! *************************************************************************
50 : :
51 : : contains
52 : : !!***
53 : :
54 : : !!****f* m_frskerker2/frskerker2__init
55 : : !! NAME
56 : : !! frskerker2__init
57 : : !!
58 : : !! FUNCTION
59 : : !! initialisation subroutine
60 : : !! Copy every variables required for the energy calculation
61 : : !! Allocate the required memory
62 : : !!
63 : : !! INPUTS
64 : : !!
65 : : !! OUTPUT
66 : : !!
67 : : !! SOURCE
68 : :
69 : 8 : subroutine frskerker2__init(dtset_in,mpi_enreg_in,nfft_in,ngfft_in,nspden_in,rdielng_in,deltaW_in,gprimd_in,mat_in )
70 : :
71 : : !Arguments ------------------------------------
72 : : type(dataset_type),target,intent(in) :: dtset_in
73 : : integer,intent(in) :: nfft_in,ngfft_in(18),nspden_in
74 : : real(dp),intent(in) :: deltaW_in(nfft_in,nspden_in),mat_in(nfft_in,nspden_in)
75 : : real(dp),intent(in) :: rdielng_in(nfft_in)
76 : : real(dp),intent(in) :: gprimd_in(3,3)
77 : : type(MPI_type),target,intent(in) :: mpi_enreg_in
78 : :
79 : : ! *************************************************************************
80 : : ! !allocation and data transfer
81 : : ! !Thought it would have been more logical to use the privates intrinsic of the module as
82 : : ! !input variables it seems that it is not possible...
83 [ + - ]: 8 : if(.not.ok) then
84 : 8 : dtset_ptr => dtset_in
85 : 8 : mpi_enreg_ptr => mpi_enreg_in
86 : 8 : nspden=nspden_in
87 : 8 : ngfft=ngfft_in
88 : 8 : nfft=nfft_in
89 [ - + + - : 32 : ABI_MALLOC(deltaW,(size(deltaW_in,1),size(deltaW_in,2)))
- + + - +
- + - - +
- + - + ]
90 [ - + + - : 24 : ABI_MALLOC(mat,(size(mat_in,1),size(mat_in,2)))
- + + - -
+ - + -
+ ]
91 [ - + + - : 24 : ABI_MALLOC(rdielng,(size(rdielng_in)))
+ - + - -
+ - + -
+ ]
92 [ + - + - : 80024 : deltaW=deltaW_in
- + - - +
+ + + ]
93 [ + - - + : 80016 : rdielng=rdielng_in
- - + + ]
94 [ + - + - : 80024 : mat=mat_in
- + - - +
+ + + ]
95 : 8 : gprimd=gprimd_in
96 : 8 : ok = .true.
97 : : end if
98 : :
99 : 8 : end subroutine frskerker2__init
100 : : !!***
101 : :
102 : : !!****f* m_frskerker2/frskerker2__end
103 : : !! NAME
104 : : !! frskerker2__end
105 : : !!
106 : : !! FUNCTION
107 : : !! ending subroutine
108 : : !! deallocate memory areas
109 : : !!
110 : : !! INPUTS
111 : : !!
112 : : !! OUTPUT
113 : : !!
114 : : !! SOURCE
115 : :
116 : 8 : subroutine frskerker2__end()
117 : :
118 : : ! *************************************************************************
119 [ + - ]: 8 : if(ok) then
120 : : ! ! set ok to false which prevent using the pf and dpf
121 : 8 : ok = .false.
122 : : ! ! free memory
123 [ - + ]: 8 : ABI_FREE(deltaW)
124 [ - + ]: 8 : ABI_FREE(mat)
125 [ - + ]: 8 : ABI_FREE(rdielng)
126 : : end if
127 : :
128 : 8 : end subroutine frskerker2__end
129 : : !!***
130 : :
131 : : !!****f* m_frskerker2/frskerker2__newvres2
132 : : !! NAME
133 : : !! frskerker2__newvres2
134 : : !!
135 : : !! FUNCTION
136 : : !! affectation subroutine
137 : : !! do the required renormalisation when providing a new value for
138 : : !! the density after application of the gradient
139 : : !!
140 : : !! INPUTS
141 : : !!
142 : : !! OUTPUT
143 : : !!
144 : : !! SOURCE
145 : :
146 : 114 : subroutine frskerker2__newvres2(nv1,nv2,x, grad, vrespc)
147 : :
148 : : !Arguments ------------------------------------
149 : : integer,intent(in) :: nv1,nv2
150 : : real(dp),intent(in) :: x
151 : : real(dp),intent(inout)::grad(nv1,nv2)
152 : : real(dp),intent(inout)::vrespc(nv1,nv2)
153 : :
154 : : ! *************************************************************************
155 [ + + + + ]: 1140228 : grad(:,:)=x*grad(:,:)
156 [ + + + + ]: 1140228 : vrespc(:,:)=vrespc(:,:)+grad(:,:)
157 : :
158 : 114 : end subroutine frskerker2__newvres2
159 : : !!***
160 : :
161 : : !!****f* m_frskerker2/frskerker2__pf
162 : : !! NAME
163 : : !! frskerker2__pf
164 : : !!
165 : : !! FUNCTION
166 : : !! penalty function associated with the preconditionned residuals
167 : : !!
168 : : !! INPUTS
169 : : !!
170 : : !! OUTPUT
171 : : !!
172 : : !! SOURCE
173 : :
174 : 1347 : function frskerker2__pf(nv1,nv2,vrespc)
175 : :
176 : : !Arguments ------------------------------------
177 : : integer,intent(in) :: nv1,nv2
178 : : real(dp),intent(in) ::vrespc(nv1,nv2)
179 : : real(dp) ::frskerker2__pf
180 : :
181 : : !Local variables-------------------------------
182 : 2694 : real(dp) :: buffer1(nv1,nv2),buffer2(nv1,nv2)
183 : : integer :: ispden
184 : : ! *************************************************************************
185 : :
186 [ + - ]: 1347 : if(ok) then
187 [ + + + + ]: 13472694 : buffer1=vrespc
188 : 1347 : call laplacian(gprimd,mpi_enreg_ptr,nfft,nspden,ngfft,rdfuncr=buffer1,laplacerdfuncr=buffer2)
189 [ + + ]: 2694 : do ispden=1,nspden
190 : : buffer2(:,ispden)=(vrespc(:,ispden)-((rdielng(:))**2)*buffer2(:,ispden)) &
191 [ + + ]: 13472694 : & *half - deltaW(:,ispden)
192 : : end do
193 : : ! pf_rscgres=dotproduct(vrespc,buffer2)*half-dotproduct(vrespc,deltaW)
194 : 1347 : frskerker2__pf=dotproduct(nv1,nv2,vrespc,buffer2)
195 : : else
196 : : frskerker2__pf=zero
197 : : end if
198 : 1347 : end function frskerker2__pf
199 : : !!***
200 : :
201 : : !!****f* m_frskerker2/frskerker2__dpf
202 : : !! NAME
203 : : !! frskerker2__dpf
204 : : !!
205 : : !! FUNCTION
206 : : !! derivative of the penalty function
207 : : !! actually not the derivative but something allowing minimization
208 : : !! at constant density
209 : : !! formula from the work of rackowski,canning and wang
210 : : !! H*phi - int(phi**2H d3r)phi
211 : : !! that is the simple projection of the change on a direction
212 : : !! normal to the density changes
213 : : !!
214 : : !! INPUTS
215 : : !!
216 : : !! OUTPUT
217 : : !!
218 : : !! SOURCE
219 : :
220 : 2643 : function frskerker2__dpf(nv1,nv2,vrespc)
221 : :
222 : : !Arguments ------------------------------------
223 : : integer,intent(in) :: nv1,nv2
224 : : real(dp),intent(in)::vrespc(nv1,nv2)
225 : : real(dp) :: frskerker2__dpf(nv1,nv2)
226 : :
227 : : !Local variables-------------------------------
228 [ - + ]: 881 : real(dp):: buffer1(nv1,nv2),buffer2(nv1,nv2)
229 : : integer :: ispden
230 : :
231 : : ! *************************************************************************
232 : :
233 [ - + ]: 881 : if(ok) then
234 [ + + + + ]: 8811762 : buffer1=vrespc
235 : 881 : call laplacian(gprimd,mpi_enreg_ptr,nfft,nspden,ngfft,rdfuncr=buffer1,laplacerdfuncr=buffer2)
236 [ + + ]: 1762 : do ispden=1,nspden
237 [ + + ]: 8811762 : frskerker2__dpf(:,ispden)= vrespc(:,ispden)-deltaW(:,ispden)-((rdielng(:))**2)*buffer2(:,ispden)
238 : : end do
239 : : else
240 [ # # # # ]: 0 : frskerker2__dpf = zero
241 : : end if
242 : :
243 : : end function frskerker2__dpf
244 : : !!***
245 : :
246 : : end module m_frskerker2
247 : : !!***
|
