Line data Source code
1 : !!****m* ABINIT/m_predict_string
2 : !! NAME
3 : !! m_predict_string
4 : !!
5 : !! FUNCTION
6 : !!
7 : !!
8 : !! COPYRIGHT
9 : !! Copyright (C) 2009-2026 ABINIT group (XG,ARom,MT)
10 : !! This file is distributed under the terms of the
11 : !! GNU General Public License, see ~abinit/COPYING
12 : !! or http://www.gnu.org/copyleft/gpl.txt .
13 : !!
14 : !! SOURCE
15 :
16 : #if defined HAVE_CONFIG_H
17 : #include "config.h"
18 : #endif
19 :
20 : #include "abi_common.h"
21 :
22 : module m_predict_string
23 :
24 : use defs_basis
25 : use m_abicore
26 : use m_splines
27 : use m_mep
28 : use m_errors
29 : use m_xmpi
30 :
31 : use defs_abitypes, only : MPI_type
32 : use m_results_img, only : results_img_type, gather_array_img, get_geometry_img
33 :
34 : implicit none
35 :
36 : private
37 : !!***
38 :
39 : public :: predict_string
40 : !!***
41 :
42 : contains
43 : !!***
44 :
45 : !!****f* ABINIT/predict_string
46 : !! NAME
47 : !! predict_string
48 : !!
49 : !! FUNCTION
50 : !! Given the past history of images, predict the new set of images using String Method.
51 : !! The changes on the geometry and others are predicted by rescaling the path
52 : !! No change of acell, rprim and vel at present.
53 : !!
54 : !! INPUTS
55 : !! itimimage=time index for image propagation (itimimage+1 is to be predicted here)
56 : !! itimimage_eff=time index in the history
57 : !! list_dynimage(nimage)=list of dynamical images. The non-dynamical ones will not change.
58 : !! Example : in the NEB of string method, one expect the two end images to be fixed.
59 : !! This is quite useful when ground states of the A and B states is known
60 : !! mpi_enreg=MPI-parallelisation information
61 : !! natom=dimension of vel_timimage and xred_timimage
62 : !! ndynimage=number of dynamical images
63 : !! nimage=number of images (on current proc)
64 : !! nimage_tot=total number of images
65 : !! ntimimage_stored=number of time steps stored in the history
66 : !!
67 : !! OUTPUT
68 : !!
69 : !! SIDE EFFECTS
70 : !! mep_param=several parameters for Minimal Energy Path (MEP) search
71 : !! results_img(ntimimage_stored,nimage)=datastructure that holds the history of previous computations.
72 : !! results_img(:,:)%acell(3)
73 : !! at input, history of the values of acell for all images
74 : !! at output, the predicted values of acell for all images
75 : !! results_img(:,:)%results_gs
76 : !! at input, history of the values of energies and forces for all images
77 : !! results_img(:,:)%rprim(3,3)
78 : !! at input, history of the values of rprim for all images
79 : !! at output, the predicted values of rprim for all images
80 : !! results_img(:,:)%vel(3,natom)
81 : !! at input, history of the values of vel for all images
82 : !! at output, the predicted values of vel for all images
83 : !! results_img(:,:)%vel_cell(3,3)
84 : !! at input, history of the values of vel_cell for all images
85 : !! at output, the predicted values of vel_cell for all images
86 : !! results_img(:,:)%xred(3,natom)
87 : !! at input, history of the values of xred for all images
88 : !! at output, the predicted values of xred for all images
89 : !!
90 : !! SOURCE
91 :
92 182 : subroutine predict_string(itimimage,itimimage_eff,list_dynimage,mep_param,mpi_enreg,natom,&
93 182 : & ndynimage,nimage,nimage_tot,ntimimage_stored,results_img)
94 :
95 : !Arguments ------------------------------------
96 : !scalars
97 : integer,intent(in) :: itimimage,itimimage_eff,natom,ndynimage
98 : integer,intent(in) :: nimage,nimage_tot,ntimimage_stored
99 : type(mep_type),intent(inout) :: mep_param
100 : type(MPI_type),intent(in) :: mpi_enreg
101 : !arrays
102 : integer,intent(in) :: list_dynimage(ndynimage)
103 : type(results_img_type) :: results_img(nimage,ntimimage_stored)
104 :
105 : !Local variables-------------------------------
106 : !scalars
107 : integer :: idynimage,ierr,ii,iimage,iatom,next_itimimage
108 : real(dp) :: emax,emin,step
109 : !arrays
110 182 : real(dp),allocatable :: buffer(:,:),buffer_all(:,:)
111 182 : real(dp),allocatable :: darc(:),dimage(:),fcart(:,:,:),rprimd(:,:,:),vect(:,:),wimage(:)
112 182 : real(dp),allocatable :: x(:),y(:),z(:),x2(:),y2(:),z2(:)
113 182 : real(dp),allocatable :: xout(:),yout(:),zout(:)
114 182 : real(dp),allocatable,target :: etotal(:),xcart(:,:,:),xred(:,:,:),strten(:,:)
115 182 : real(dp),pointer :: etotal_all(:),xcart_all(:,:,:),xred_all(:,:,:)
116 :
117 : ! *************************************************************************
118 :
119 728 : ABI_MALLOC(xred,(3,natom,nimage))
120 :
121 : !Parallelism over images: only one process per image of the cell
122 182 : if (mpi_enreg%me_cell==0) then
123 :
124 : ! Retrieve positions and forces
125 258 : ABI_MALLOC(etotal,(nimage))
126 258 : ABI_MALLOC(xcart,(3,natom,nimage))
127 258 : ABI_MALLOC(fcart,(3,natom,nimage))
128 258 : ABI_MALLOC(rprimd,(3,3,nimage))
129 258 : ABI_MALLOC(strten,(6,nimage))
130 : call get_geometry_img(results_img(:,itimimage_eff),etotal,natom,nimage,&
131 86 : & fcart,rprimd,strten,xcart,xred)
132 :
133 : ! EVOLUTION STEP
134 : ! ===============================================
135 :
136 : ! Compute new atomic positions in each cell
137 86 : if (mep_param%mep_solver==MEP_SOLVER_STEEPEST) then ! Steepest-descent
138 86 : call mep_steepest(fcart,list_dynimage,mep_param,natom,natom,ndynimage,nimage,rprimd,xcart,xred)
139 0 : else if (mep_param%mep_solver==MEP_SOLVER_RK4) then ! 4th-order Runge-Kutta
140 0 : call mep_rk4(fcart,itimimage,list_dynimage,mep_param,natom,ndynimage,nimage,rprimd,xcart,xred)
141 : else
142 0 : ABI_BUG("Inconsistent solver !")
143 : end if
144 :
145 : ! REPARAMETRIZATION STEP
146 : ! ===============================================
147 :
148 : ! No reparametrization step in case of Runge-Kutta and mod(istep,4)>0
149 86 : if (mep_param%mep_solver/=MEP_SOLVER_RK4.or.mod(itimimage,4)==0) then
150 :
151 : ! Parallelism: gather data of all images
152 86 : if (mpi_enreg%paral_img==1) then
153 0 : ABI_MALLOC(buffer,(6*natom+1,nimage))
154 0 : ABI_MALLOC(buffer_all,(6*natom+1,nimage_tot))
155 0 : ABI_MALLOC(xred_all,(3,natom,nimage_tot))
156 0 : ABI_MALLOC(xcart_all,(3,natom,nimage_tot))
157 0 : ABI_MALLOC(etotal_all,(nimage_tot))
158 0 : buffer=zero;ii=0
159 0 : buffer(ii+1:ii+3*natom,1:nimage)=reshape(xred ,(/3*natom,nimage/));ii=3*natom
160 0 : buffer(ii+1:ii+3*natom,1:nimage)=reshape(xcart,(/3*natom,nimage/));ii=6*natom
161 0 : buffer(ii+1 ,1:nimage)=etotal(1:nimage);ii=0
162 0 : call gather_array_img(buffer,buffer_all,mpi_enreg,allgather=.true.)
163 0 : xred_all(:,:,:) =reshape(buffer_all(ii+1:ii+3*natom,1:nimage_tot),(/3,natom,nimage_tot/));ii=3*natom
164 0 : xcart_all(:,:,:)=reshape(buffer_all(ii+1:ii+3*natom,1:nimage_tot),(/3,natom,nimage_tot/));ii=6*natom
165 0 : etotal_all(:)=buffer_all(ii+1,1:nimage_tot);ii=0
166 0 : ABI_FREE(buffer)
167 0 : ABI_FREE(buffer_all)
168 : else
169 86 : xred_all => xred
170 86 : xcart_all => xcart
171 86 : etotal_all => etotal
172 : end if
173 :
174 : ! dimage is the distance between two images
175 : ! darc is the parametrization on the string
176 : ! wimage is the weight
177 258 : ABI_MALLOC(darc,(nimage_tot))
178 172 : ABI_MALLOC(dimage,(nimage_tot))
179 172 : ABI_MALLOC(wimage,(nimage_tot))
180 :
181 : ! === Weights for equal arc length
182 86 : if (mep_param%string_algo/=STRING_ALGO_SIMPLIFIED_ENERGY) then
183 674 : wimage(:)=one
184 :
185 : ! === Weights for energy-weight arc length
186 : else
187 0 : emin=min(etotal_all(1),etotal_all(nimage_tot))
188 0 : emax=maxval(etotal_all(:))
189 0 : wimage(1)=one
190 0 : do iimage=2,nimage_tot
191 0 : wimage(iimage)=exp((half*(etotal_all(iimage)+etotal_all(iimage-1))-emin)/(emax-emin))
192 : end do
193 : end if
194 :
195 : ! The distance between images is calculated
196 : ! and normalized to a string length of 1.0
197 674 : dimage=zero
198 258 : ABI_MALLOC(vect,(3,natom))
199 588 : do iimage=2,nimage_tot
200 502 : dimage(iimage)=dimage(iimage-1)
201 : ! MT april 2012: distance must be computed with cartesian coordinates
202 : ! vect(:,:)=xred_all(:,:,iimage)-xred_all(:,:,iimage-1)
203 4518 : vect(:,:)=xcart_all(:,:,iimage)-xcart_all(:,:,iimage-1)
204 588 : dimage(iimage)=dimage(iimage)+wimage(iimage)*mep_img_norm(vect)
205 : end do
206 674 : dimage(:)=dimage(:)/dimage(nimage_tot)
207 86 : ABI_FREE(vect)
208 :
209 : ! Arc lengths
210 86 : darc(1)=zero
211 86 : step=one/dble(nimage_tot-1)
212 588 : do iimage=2,nimage_tot
213 588 : darc(iimage)=darc(iimage-1)+step
214 : end do
215 :
216 : ! New image coordinates are calculated and such that now the mesh is uniform
217 172 : ABI_MALLOC(x,(nimage_tot))
218 172 : ABI_MALLOC(y,(nimage_tot))
219 172 : ABI_MALLOC(z,(nimage_tot))
220 172 : ABI_MALLOC(x2,(nimage_tot))
221 172 : ABI_MALLOC(y2,(nimage_tot))
222 172 : ABI_MALLOC(z2,(nimage_tot))
223 172 : ABI_MALLOC(xout,(nimage_tot))
224 172 : ABI_MALLOC(yout,(nimage_tot))
225 172 : ABI_MALLOC(zout,(nimage_tot))
226 258 : do iatom=1,natom
227 1348 : do iimage=1,nimage_tot
228 1176 : x(iimage)=xred_all(1,iatom,iimage)
229 1176 : y(iimage)=xred_all(2,iatom,iimage)
230 1348 : z(iimage)=xred_all(3,iatom,iimage)
231 : end do
232 172 : call spline(dimage,x,nimage_tot,greatest_real,greatest_real,x2)
233 172 : call spline(dimage,y,nimage_tot,greatest_real,greatest_real,y2)
234 172 : call spline(dimage,z,nimage_tot,greatest_real,greatest_real,z2)
235 172 : call splint(nimage_tot,dimage,x,x2,nimage_tot,darc,xout)
236 172 : call splint(nimage_tot,dimage,y,y2,nimage_tot,darc,yout)
237 172 : call splint(nimage_tot,dimage,z,z2,nimage_tot,darc,zout)
238 : ! After a spline, new image coordinate for that particular
239 : ! atom are generated only if they are dynamical
240 1090 : do idynimage=1,ndynimage
241 832 : iimage=list_dynimage(idynimage)
242 832 : ii=mpi_enreg%my_imgtab(iimage)
243 832 : xred(1,iatom,iimage)=xout(ii)
244 832 : xred(2,iatom,iimage)=yout(ii)
245 1004 : xred(3,iatom,iimage)=zout(ii)
246 : end do
247 : end do ! iatom
248 :
249 : ! Free memory
250 86 : ABI_FREE(x)
251 86 : ABI_FREE(y)
252 86 : ABI_FREE(z)
253 86 : ABI_FREE(x2)
254 86 : ABI_FREE(y2)
255 86 : ABI_FREE(z2)
256 86 : ABI_FREE(xout)
257 86 : ABI_FREE(yout)
258 86 : ABI_FREE(zout)
259 86 : ABI_FREE(darc)
260 86 : ABI_FREE(dimage)
261 86 : ABI_FREE(wimage)
262 86 : if (mpi_enreg%paral_img==1) then
263 0 : ABI_FREE(xred_all)
264 0 : ABI_FREE(xcart_all)
265 0 : ABI_FREE(etotal_all)
266 : end if
267 :
268 : end if ! Reparametrization
269 :
270 : ! ===============================================
271 :
272 86 : ABI_FREE(etotal)
273 86 : ABI_FREE(xcart)
274 86 : ABI_FREE(fcart)
275 86 : ABI_FREE(rprimd)
276 86 : ABI_FREE(strten)
277 : end if ! mpi_enreg%me_cell==0
278 :
279 : !Store acell, rprim, xred and vel for the new iteration
280 182 : call xmpi_bcast(xred,0,mpi_enreg%comm_cell,ierr)
281 182 : next_itimimage=itimimage_eff+1
282 182 : if (next_itimimage>ntimimage_stored) next_itimimage=1
283 1442 : do iimage=1,nimage
284 11340 : results_img(iimage,next_itimimage)%xred(:,:) =xred(:,:,iimage)
285 5040 : results_img(iimage,next_itimimage)%acell(:) =results_img(iimage,itimimage_eff)%acell(:)
286 16380 : results_img(iimage,next_itimimage)%rprim(:,:) =results_img(iimage,itimimage_eff)%rprim(:,:)
287 11340 : results_img(iimage,next_itimimage)%vel(:,:) =results_img(iimage,itimimage_eff)%vel(:,:)
288 16562 : results_img(iimage,next_itimimage)%vel_cell(:,:)=results_img(iimage,itimimage_eff)%vel_cell(:,:)
289 : end do
290 182 : ABI_FREE(xred)
291 :
292 364 : end subroutine predict_string
293 : !!***
294 :
295 : end module m_predict_string
296 : !!***
|
