TABLE OF CONTENTS


ABINIT/m_frskerker2 [ Modules ]

[ Top ] [ Modules ]

NAME

 m_frskerker2

FUNCTION

 provide the ability to compute the
 penalty function and its first derivative associated
 with some residuals and a real space dielectric function

COPYRIGHT

 Copyright (C) 1998-2018 ABINIT group (DCA, XG, MT)
 This file is distributed under the terms of the
 GNU General Public License, see ~ABINIT/COPYING
 or http://www.gnu.org/copyleft/gpl.txt .
 For the initials of contributors, see ~ABINIT/Infos/contributors .

NOTES

 this is neither a function nor a subroutine. This is a module
 It is made of two functions and one init subroutine

PARENTS

CHILDREN

SOURCE

28 #if defined HAVE_CONFIG_H
29 #include "config.h"
30 #endif
31 
32 #include "abi_common.h"
33 
34 module m_frskerker2
35 
36   use defs_basis
37   use defs_abitypes
38   use m_abicore
39 
40   use m_spacepar, only : laplacian
41   use m_numeric_tools, only : dotproduct
42 
43   implicit none
44 
45   !! common variables copied from input
46   integer,save,private                  :: nfft,nspden,ngfft(18)
47   real(dp),save,allocatable,private    :: deltaW(:,:),mat(:,:),rdielng(:)
48   real(dp),save,private                :: gprimd(3,3)
49   type(dataset_type),pointer,save,private  :: dtset_ptr
50   type(MPI_type),pointer,save,private  :: mpi_enreg_ptr
51   !! common variables computed
52   logical,save,private :: ok=.false.
53 ! *************************************************************************
54 
55 contains

m_frskerker2/frskerker2__dpf [ Functions ]

[ Top ] [ m_frskerker2 ] [ Functions ]

NAME

 frskerker2__dpf

FUNCTION

 derivative of the penalty function
 actually not the derivative but something allowing minimization
 at constant density
 formula from the work of rackowski,canning and wang
 H*phi - int(phi**2H d3r)phi
 that is the simple projection of the change on a direction
 normal to the density changes

INPUTS

OUTPUT

PARENTS

CHILDREN

SOURCE

285 function frskerker2__dpf(nv1,nv2,vrespc)
286 
287 
288 !This section has been created automatically by the script Abilint (TD).
289 !Do not modify the following lines by hand.
290 #undef ABI_FUNC
291 #define ABI_FUNC 'frskerker2__dpf'
292 !End of the abilint section
293 
294  implicit none
295 
296 !Arguments ------------------------------------
297  integer,intent(in) :: nv1,nv2
298  real(dp),intent(in)::vrespc(nv1,nv2)
299  real(dp)           :: frskerker2__dpf(nv1,nv2)
300 
301 !Local variables-------------------------------
302  real(dp):: buffer1(nv1,nv2),buffer2(nv1,nv2)
303  integer :: ispden
304 
305 ! *************************************************************************
306 
307   if(ok) then
308    buffer1=vrespc
309    call laplacian(gprimd,mpi_enreg_ptr,nfft,nspden,ngfft,dtset_ptr%paral_kgb,rdfuncr=buffer1,laplacerdfuncr=buffer2)
310    do ispden=1,nspden
311     frskerker2__dpf(:,ispden)= vrespc(:,ispden)-deltaW(:,ispden)-((rdielng(:))**2)*buffer2(:,ispden)
312    end do
313   else
314    frskerker2__dpf = zero
315   end if
316 
317 end function frskerker2__dpf

m_frskerker2/frskerker2__end [ Functions ]

[ Top ] [ m_frskerker2 ] [ Functions ]

NAME

 frskerker2__end

FUNCTION

 ending subroutine
 deallocate memory areas

INPUTS

OUTPUT

PARENTS

      prcrskerker2

CHILDREN

      laplacian

SOURCE

141   subroutine frskerker2__end()
142 
143 
144 !This section has been created automatically by the script Abilint (TD).
145 !Do not modify the following lines by hand.
146 #undef ABI_FUNC
147 #define ABI_FUNC 'frskerker2__end'
148 !End of the abilint section
149 
150  implicit none
151 
152 ! *************************************************************************
153   if(ok) then
154 !  ! set ok to false which prevent using the pf and dpf
155    ok = .false.
156 !  ! free memory
157    ABI_DEALLOCATE(deltaW)
158    ABI_DEALLOCATE(mat)
159    ABI_DEALLOCATE(rdielng)
160   end if
161 
162  end subroutine frskerker2__end

m_frskerker2/frskerker2__init [ Functions ]

[ Top ] [ m_frskerker2 ] [ Functions ]

NAME

 frskerker2__init

FUNCTION

 initialisation subroutine
 Copy every variables required for the energy calculation
 Allocate the required memory

INPUTS

OUTPUT

PARENTS

      prcrskerker2

CHILDREN

      laplacian

SOURCE

 79 subroutine frskerker2__init(dtset_in,mpi_enreg_in,nfft_in,ngfft_in,nspden_in,rdielng_in,deltaW_in,gprimd_in,mat_in )
 80 
 81 
 82 !This section has been created automatically by the script Abilint (TD).
 83 !Do not modify the following lines by hand.
 84 #undef ABI_FUNC
 85 #define ABI_FUNC 'frskerker2__init'
 86 !End of the abilint section
 87 
 88  implicit none
 89 
 90 !Arguments ------------------------------------
 91  type(dataset_type),target,intent(in) :: dtset_in
 92  integer,intent(in)  :: nfft_in,ngfft_in(18),nspden_in
 93  real(dp),intent(in) :: deltaW_in(nfft_in,nspden_in),mat_in(nfft_in,nspden_in)
 94  real(dp),intent(in) :: rdielng_in(nfft_in)
 95  real(dp),intent(in)  :: gprimd_in(3,3)
 96  type(MPI_type),target,intent(in)  :: mpi_enreg_in
 97 
 98 ! *************************************************************************
 99 ! !allocation and data transfer
100 ! !Thought it would have been more logical to use the privates intrinsic of the module as
101 ! !input variables it seems that it is not possible...
102   if(.not.ok) then
103    dtset_ptr => dtset_in
104    mpi_enreg_ptr => mpi_enreg_in
105    nspden=nspden_in
106    ngfft=ngfft_in
107    nfft=nfft_in
108    ABI_ALLOCATE(deltaW,(size(deltaW_in,1),size(deltaW_in,2)))
109    ABI_ALLOCATE(mat,(size(mat_in,1),size(mat_in,2)))
110    ABI_ALLOCATE(rdielng,(size(rdielng_in)))
111    deltaW=deltaW_in
112    rdielng=rdielng_in
113    mat=mat_in
114    gprimd=gprimd_in
115    ok = .true.
116   end if
117 
118  end subroutine frskerker2__init

m_frskerker2/frskerker2__newvres2 [ Functions ]

[ Top ] [ m_frskerker2 ] [ Functions ]

NAME

 frskerker2__newvres2

FUNCTION

 affectation subroutine
 do the required renormalisation when providing a new value for
 the density after application of the gradient

INPUTS

OUTPUT

PARENTS

CHILDREN

      laplacian

SOURCE

185 subroutine frskerker2__newvres2(nv1,nv2,x, grad, vrespc)
186 
187 
188 !This section has been created automatically by the script Abilint (TD).
189 !Do not modify the following lines by hand.
190 #undef ABI_FUNC
191 #define ABI_FUNC 'frskerker2__newvres2'
192 !End of the abilint section
193 
194  implicit none
195 
196 !Arguments ------------------------------------
197  integer,intent(in)    :: nv1,nv2
198  real(dp),intent(in)   :: x
199  real(dp),intent(inout)::grad(nv1,nv2)
200  real(dp),intent(inout)::vrespc(nv1,nv2)
201 
202 ! *************************************************************************
203   grad(:,:)=x*grad(:,:)
204   vrespc(:,:)=vrespc(:,:)+grad(:,:)
205 
206  end subroutine frskerker2__newvres2

m_frskerker2/frskerker2__pf [ Functions ]

[ Top ] [ m_frskerker2 ] [ Functions ]

NAME

 frskerker2__pf

FUNCTION

 penalty function associated with the preconditionned residuals

INPUTS

OUTPUT

PARENTS

CHILDREN

SOURCE

226   function frskerker2__pf(nv1,nv2,vrespc)
227 
228 
229 !This section has been created automatically by the script Abilint (TD).
230 !Do not modify the following lines by hand.
231 #undef ABI_FUNC
232 #define ABI_FUNC 'frskerker2__pf'
233 !End of the abilint section
234 
235  implicit none
236 
237 !Arguments ------------------------------------
238  integer,intent(in)    :: nv1,nv2
239  real(dp),intent(in) ::vrespc(nv1,nv2)
240  real(dp)            ::frskerker2__pf
241 
242 !Local variables-------------------------------
243  real(dp)            :: buffer1(nv1,nv2),buffer2(nv1,nv2)
244  integer             :: ispden
245 ! *************************************************************************
246 
247   if(ok) then
248    buffer1=vrespc
249    call laplacian(gprimd,mpi_enreg_ptr,nfft,nspden,ngfft,dtset_ptr%paral_kgb,rdfuncr=buffer1,laplacerdfuncr=buffer2)
250    do ispden=1,nspden
251     buffer2(:,ispden)=(vrespc(:,ispden)-((rdielng(:))**2)*buffer2(:,ispden))  &
252 &    *half  -  deltaW(:,ispden)
253    end do
254 !  pf_rscgres=dotproduct(vrespc,buffer2)*half-dotproduct(vrespc,deltaW)
255    frskerker2__pf=dotproduct(nv1,nv2,vrespc,buffer2)
256   else
257    frskerker2__pf=zero
258   end if
259  end function frskerker2__pf