Branch data Line data Source code
1 : : !!****m* ABINIT/m_abihist
2 : : !! NAME
3 : : !! m_abihist
4 : : !!
5 : : !! FUNCTION
6 : : !! This module contains definition the type abihist and its related routines
7 : : !!
8 : : !! Datatypes:
9 : : !!
10 : : !! * abihist: Historical record of atomic positions forces and cell parameters
11 : : !!
12 : : !! Subroutines:
13 : : !!
14 : : !! * abihist_init
15 : : !! * abihist_free
16 : : !! * abihist_bcast
17 : : !! * abihist_compare
18 : : !! * hist2var
19 : : !! * var2hist
20 : : !! * vel2hist
21 : : !!
22 : : !! COPYRIGHT
23 : : !! Copyright (C) 2001-2026 ABINIT group (XG, SE)
24 : : !! This file is distributed under the terms of the
25 : : !! GNU General Public License, see ~abinit/COPYING
26 : : !! or http://www.gnu.org/copyleft/gpl.txt .
27 : : !!
28 : : !! SOURCE
29 : :
30 : : #if defined HAVE_CONFIG_H
31 : : #include "config.h"
32 : : #endif
33 : :
34 : : #include "abi_common.h"
35 : :
36 : : module m_abihist
37 : :
38 : : use defs_basis
39 : : use m_abicore
40 : : use m_errors
41 : : use m_xmpi
42 : : use netcdf
43 : : use m_nctk
44 : :
45 : : use m_geometry, only : fcart2gred, xred2xcart
46 : :
47 : : implicit none
48 : :
49 : : private
50 : : !!***
51 : :
52 : : !----------------------------------------------------------------------
53 : :
54 : : !!****t* m_abihist/abihist
55 : : !! NAME
56 : : !! abihist
57 : : !!
58 : : !! FUNCTION
59 : : !! This type has several vectors, and index scalars to store
60 : : !! a proper history of previous evaluations of forces and
61 : : !! stresses, velocities, positions and energies.
62 : : !!
63 : : !! It contains:
64 : : !! * mxhist : Maximum size of history
65 : : !! * ihist : index of history
66 : : !! * acell(3,mxhist) : Acell
67 : : !! * rprimd(3,3,mxhist) : Rprimd
68 : : !! * xred(3,natom,mxhist) : Xred
69 : : !! * fcart(3,natom,mxhist) : Fcart
70 : : !! * strten(6,mxhist) : STRten
71 : : !! * vel(3,natom,mxhist) : Velocities of atoms
72 : : !! * vel_cell(3,natom,mxhist): Velocities of cell
73 : : !! * etot(mxhist) : Electronic total Energy
74 : : !! * ekin(mxhist) : Ionic Kinetic Energy
75 : : !! * entropy(mxhist) : Entropy
76 : : !! * time(mxhist) : Time (or iteration number for GO)
77 : : !!
78 : : !! NOTES
79 : : !! The vectors are not allocated because in some cases
80 : : !! not all the vectors are needed, in particular a history
81 : : !! of stresses is only needed if optcell/=0, and a history
82 : : !! of velocities is needed for ionmov==1
83 : : !!
84 : : !! Store acell, rprimd and strten even with optcell/=0
85 : : !! represent a waste of 12x (dp)[Usually 8 Bytes] per
86 : : !! iteration, the reason to store all the records is
87 : : !! because some routines (eg bfgs.F90) uses the metric (gmet)
88 : : !! for initialize the hessian and we need rprimd for that.
89 : : !!
90 : : !! SOURCE
91 : :
92 : : type, public :: abihist
93 : :
94 : : ! scalars
95 : : ! Index of the last element on all records
96 : : integer :: ihist = 0
97 : : ! Maximun size of the historical records
98 : : integer :: mxhist = 0
99 : : ! Number of Degrees of Freedom
100 : : integer :: ndof = 0
101 : : ! Booleans to know if some arrays are changing
102 : : logical :: isVused ! If velocities are changing
103 : : logical :: isARused ! If Acell and Rprimd are changing
104 : :
105 : : ! arrays
106 : : ! Vector of (x,y,z)x(mxhist) values of cell dimensions
107 : : real(dp), allocatable :: acell(:,:)
108 : : ! Vector of (x,y,z)x(x,y,z)x(mxhist) values of primitive vectors
109 : : real(dp), allocatable :: rprimd(:,:,:)
110 : : ! Vector of (x,y,z)x(natom)x(mxhist) values of reduced coordinates
111 : : real(dp), allocatable :: xred(:,:,:)
112 : : ! Vector of (x,y,z)x(natom)x(mxhist) values of cartesian forces
113 : : real(dp), allocatable :: fcart(:,:,:)
114 : : ! Vector of (6)x(mxhist) values of stress tensor
115 : : real(dp), allocatable :: strten(:,:)
116 : : ! Vector of (x,y,z)x(natom)x(mxhist) values of atomic velocities
117 : : real(dp), allocatable :: vel(:,:,:)
118 : : ! Vector of (x,y,z)x(x,y,z)x(mxhist) values of cell velocities
119 : : real(dp), allocatable :: vel_cell(:,:,:)
120 : : ! Vector of (mxhist) values of electronic total energy
121 : : real(dp), allocatable :: etot(:)
122 : : ! Vector of (mxhist) values of ionic kinetic energy
123 : : real(dp), allocatable :: ekin(:)
124 : : ! Vector of (mxhist) values of Entropy
125 : : real(dp), allocatable :: entropy(:)
126 : : ! Vector of (mxhist) values of time (relevant for MD calculations)
127 : : real(dp), allocatable :: time(:)
128 : :
129 : : end type abihist
130 : :
131 : : public :: abihist_init ! Initialize the object
132 : : public :: abihist_free ! Destroy the object
133 : : public :: abihist_bcast ! Broadcast the object
134 : : public :: abihist_copy ! Copy 2 HIST records
135 : : public :: abihist_compare_and_copy ! Compare 2 HIST records; if similar copy
136 : : public :: hist2var ! Get xred, acell and rprimd from the history.
137 : : public :: abihist_findIndex ! Shift history indexes
138 : : public :: var2hist ! Append xred, acell and rprimd
139 : : public :: vel2hist ! Append velocities and Kinetic Energy
140 : : public :: write_md_hist ! Write the history into a netcdf file
141 : : public :: write_md_hist_img ! Write the history into a netcdf file (with images)
142 : : public :: read_md_hist ! Read the history from a netcdf file
143 : : public :: read_md_hist_img ! Read the history from a netcdf file (with images)
144 : : public :: get_dims_hist
145 : : public :: read_csts_hist
146 : :
147 : : interface abihist_init
148 : : module procedure abihist_init_0D
149 : : module procedure abihist_init_1D
150 : : end interface abihist_init
151 : :
152 : : interface abihist_free
153 : : module procedure abihist_free_0D
154 : : module procedure abihist_free_1D
155 : : end interface abihist_free
156 : :
157 : : interface abihist_bcast
158 : : module procedure abihist_bcast_0D
159 : : module procedure abihist_bcast_1D
160 : : end interface abihist_bcast
161 : : !!***
162 : :
163 : : !----------------------------------------------------------------------
164 : :
165 : : contains !=============================================================
166 : : !!***
167 : :
168 : : !!****f* m_abihist/abihist_init_0D
169 : : !! NAME
170 : : !! abihist_init_0D
171 : : !!
172 : : !! FUNCTION
173 : : !! Initialize a hist structure - Target: scalar
174 : : !!
175 : : !! INPUTS
176 : : !! natom = Number of atoms per unit cell
177 : : !! mxhist = Maximal number of records to store
178 : : !! isVUsed,isARUsed=flags used to initialize hsit structure
179 : : !!
180 : : !! OUTPUT
181 : : !! hist <type(abihist)> = The hist to initialize
182 : : !!
183 : : !! SOURCE
184 : :
185 : 4762 : subroutine abihist_init_0D(hist,natom,mxhist,isVused,isARused)
186 : :
187 : : !Arguments ------------------------------------
188 : : class(abihist),intent(inout) :: hist
189 : : integer,intent(in) :: natom,mxhist
190 : : logical,intent(in) :: isVUsed,isARused
191 : : ! ***************************************************************
192 : :
193 : : !Initialize indexes
194 : 4762 : hist%ihist=1
195 : 4762 : hist%mxhist=mxhist
196 : 4762 : hist%ndof=3*natom
197 : :
198 : : !Initialize flags
199 : 4762 : hist%isVused=isVUsed
200 : 4762 : hist%isARused=isARUsed
201 : :
202 : : !Allocate all the histories
203 [ - + + - : 14286 : ABI_MALLOC(hist%acell,(3,mxhist))
+ - + - -
+ - + -
+ ]
204 [ - + + - : 14286 : ABI_MALLOC(hist%rprimd,(3,3,mxhist))
+ - + - -
+ - + -
+ ]
205 : :
206 [ - + + - : 19048 : ABI_MALLOC(hist%xred,(3,natom,mxhist))
- + + - +
- + - - +
- + - + ]
207 [ - + + - : 14286 : ABI_MALLOC(hist%fcart,(3,natom,mxhist))
- + + - -
+ - + -
+ ]
208 [ - + + - : 14286 : ABI_MALLOC(hist%strten,(6,mxhist))
+ - + - -
+ - + -
+ ]
209 [ - + + - : 14286 : ABI_MALLOC(hist%vel,(3,natom,mxhist))
- + + - -
+ - + -
+ ]
210 [ - + + - : 9524 : ABI_MALLOC(hist%vel_cell,(3,3,mxhist))
- + - + -
+ ]
211 [ - + + - : 14286 : ABI_MALLOC(hist%etot,(mxhist))
+ - + - -
+ - + -
+ ]
212 [ - + + - : 9524 : ABI_MALLOC(hist%ekin,(mxhist))
- + - + -
+ ]
213 [ - + + - : 9524 : ABI_MALLOC(hist%entropy,(mxhist))
- + - + -
+ ]
214 [ - + + - : 9524 : ABI_MALLOC(hist%time,(mxhist))
- + - + -
+ ]
215 : :
216 : 4762 : hist%etot(1)=zero
217 : 4762 : hist%ekin(1)=zero
218 : 4762 : hist%entropy(1)=zero
219 : 4762 : hist%time(1)=zero
220 : :
221 [ + + ]: 19048 : hist%acell(:,1)=zero
222 [ + + + + ]: 61906 : hist%rprimd(:,:,1)=zero
223 [ + + + + ]: 85182 : hist%xred(:,:,1)=zero
224 [ + + + + ]: 85182 : hist%fcart(:,:,1)=zero
225 [ + + ]: 33334 : hist%strten(:,1)=zero
226 [ + + + + ]: 85182 : hist%vel(:,:,1)=zero
227 [ + + + + : 141197 : hist%vel_cell(:,:,:)=zero
+ + ]
228 : :
229 : 4762 : end subroutine abihist_init_0D
230 : : !!***
231 : :
232 : : !----------------------------------------------------------------------
233 : :
234 : : !!****f* m_abihist/abihist_init_1D
235 : : !! NAME
236 : : !! abihist_init_1D
237 : : !!
238 : : !! FUNCTION
239 : : !! Initialize a hist structure - Target: 1D array
240 : : !!
241 : : !! INPUTS
242 : : !! natom = Number of atoms per unitary cell
243 : : !! mxhist = Maximal number of records to store
244 : : !! isVUsed,isARUsed=flags used to initialize hsit structure
245 : : !!
246 : : !! OUTPUT
247 : : !! hist(:) <type(abihist)> = The hist to initialize
248 : : !!
249 : : !! SOURCE
250 : :
251 [ - + ]: 43 : subroutine abihist_init_1D(hist,natom,mxhist,isVUsed,isARUsed)
252 : :
253 : : !Arguments ------------------------------------
254 : : integer,intent(in) :: natom,mxhist
255 : : logical,intent(in) :: isVUsed,isARUsed
256 : : type(abihist),intent(inout) :: hist(:)
257 : :
258 : : !Local variables-------------------------------
259 : : integer :: ii
260 : : ! ***************************************************************
261 : :
262 [ + + ]: 309 : do ii=1,size(hist)
263 : 309 : call abihist_init_0D(hist(ii),natom,mxhist,isVUsed,isARUsed)
264 : : end do
265 : :
266 : 43 : end subroutine abihist_init_1D
267 : : !!***
268 : :
269 : : !----------------------------------------------------------------------
270 : :
271 : : !!****f* m_abihist/abihist_free_0D
272 : : !! NAME
273 : : !! abihist_free_0D
274 : : !!
275 : : !! FUNCTION
276 : : !! Deallocate dynamic memory in a hist structure - Target: scalar
277 : : !!
278 : : !! SOURCE
279 : :
280 : 5329 : subroutine abihist_free_0D(hist)
281 : :
282 : : !Arguments ------------------------------------
283 : : class(abihist),intent(inout) :: hist
284 : : ! ***************************************************************
285 : :
286 [ + + ]: 5329 : ABI_SFREE(hist%acell)
287 [ + + ]: 5329 : ABI_SFREE(hist%rprimd)
288 [ + + ]: 5329 : ABI_SFREE(hist%xred)
289 [ + + ]: 5329 : ABI_SFREE(hist%fcart)
290 [ + + ]: 5329 : ABI_SFREE(hist%strten)
291 [ + + ]: 5329 : ABI_SFREE(hist%vel)
292 [ + + ]: 5329 : ABI_SFREE(hist%vel_cell)
293 [ + + ]: 5329 : ABI_SFREE(hist%etot)
294 [ + + ]: 5329 : ABI_SFREE(hist%ekin)
295 [ + + ]: 5329 : ABI_SFREE(hist%entropy)
296 [ + + ]: 5329 : ABI_SFREE(hist%time)
297 : :
298 : 5329 : end subroutine abihist_free_0D
299 : : !!***
300 : :
301 : : !----------------------------------------------------------------------
302 : :
303 : : !!****f* m_abihist/abihist_free_1D
304 : : !! NAME
305 : : !! abihist_free_1D
306 : : !!
307 : : !! FUNCTION
308 : : !! Deallocate dynamic memory in a hist structure - Target: 1D array
309 : : !!
310 : : !! SOURCE
311 : :
312 : 44 : subroutine abihist_free_1D(hist)
313 : :
314 : : !Arguments ------------------------------------
315 : : class(abihist),intent(inout) :: hist(:)
316 : :
317 : : !Local variables-------------------------------
318 : : integer :: ii
319 : : ! ***************************************************************
320 : :
321 [ + + ]: 315 : do ii=1,size(hist)
322 : 315 : call abihist_free_0D(hist(ii))
323 : : end do
324 : :
325 : 44 : end subroutine abihist_free_1D
326 : : !!***
327 : :
328 : : !----------------------------------------------------------------------
329 : :
330 : : !!****f* m_abihist/abihist_bcast_0D
331 : : !! NAME
332 : : !! abihist_bcast_0D
333 : : !!
334 : : !! FUNCTION
335 : : !! Broadcast a hist datastructure (from a root process to all others) - Target: scalar
336 : : !!
337 : : !! INPUTS
338 : : !! master=ID of the sending node in comm
339 : : !! comm=MPI Communicator
340 : : !!
341 : : !! SIDE EFFECTS
342 : : !! hist <type(abihist)> = The hist to broadcast
343 : : !!
344 : : !! SOURCE
345 : :
346 : 41 : subroutine abihist_bcast_0D(hist,master,comm)
347 : :
348 : : !Arguments ------------------------------------
349 : : !scalars
350 : : class(abihist),intent(inout) :: hist
351 : : integer,intent(in) :: master,comm
352 : :
353 : : !Local variables-------------------------------
354 : : !scalars
355 : : integer :: bufsize,ierr,indx,nproc,rank
356 : : integer :: sizeA,sizeA1,sizeA2
357 : : integer :: sizeEt,sizeEk,sizeEnt,sizeT
358 : : integer :: sizeR,sizeR1,sizeR2,sizeR3
359 : : integer :: sizeS,sizeS1,sizeS2
360 : : integer :: sizeV,sizeV1,sizeV2,sizeV3
361 : : integer :: sizeVc,sizeVc1,sizeVc2,sizeVc3
362 : : integer :: sizeX,sizeX1,sizeX2,sizeX3
363 : : integer :: sizeF,sizeF1,sizeF2,sizeF3
364 : : !arrays
365 : 41 : integer,allocatable :: buffer_i(:)
366 : 41 : real(dp),allocatable :: buffer_r(:)
367 : : ! ***************************************************************
368 : :
369 : 41 : ierr=0
370 : 41 : nproc=xmpi_comm_size(comm)
371 [ + + ]: 70 : if (nproc<=1) return
372 : :
373 : 12 : rank=xmpi_comm_rank(comm)
374 : :
375 : : !=== Broadcast integers and logicals
376 [ - + ]: 12 : ABI_MALLOC(buffer_i,(4))
377 [ + + ]: 12 : if (rank==master) then
378 : 4 : buffer_i(1)=hist%ihist
379 : 4 : buffer_i(2)=hist%mxhist
380 [ - + ]: 4 : buffer_i(3)=0;if (hist%isVused) buffer_i(3)=1
381 [ - + ]: 4 : buffer_i(4)=0;if (hist%isARused) buffer_i(4)=1
382 : : end if
383 : 12 : call xmpi_bcast(buffer_i,master,comm,ierr)
384 [ + + ]: 12 : if (rank/=master) then
385 : 8 : hist%ihist=buffer_i(1)
386 : 8 : hist%mxhist=buffer_i(2)
387 : 8 : hist%isVused =(buffer_i(3)==1)
388 : 8 : hist%isARused =(buffer_i(4)==1)
389 : : end if
390 [ - + ]: 12 : ABI_FREE(buffer_i)
391 : :
392 : : !If history is empty, return
393 [ + - + - ]: 12 : if (hist%mxhist==0.or.hist%ihist==0) return
394 : :
395 : : !=== Broadcast sizes of arrays
396 [ - + ]: 12 : ABI_MALLOC(buffer_i,(23))
397 [ + + ]: 12 : if (rank==master) then
398 : 4 : sizeA1=size(hist%acell,1);sizeA2=size(hist%acell,2)
399 : 4 : sizeEt=size(hist%etot,1);sizeEk=size(hist%ekin,1);
400 : 4 : sizeEnt=size(hist%entropy,1);sizeT=size(hist%time,1)
401 : 4 : sizeR1=size(hist%rprimd,1);sizeR2=size(hist%rprimd,2);sizeR3=size(hist%rprimd,3)
402 : 4 : sizeS1=size(hist%strten,1);sizeS2=size(hist%strten,2)
403 : 4 : sizeV1=size(hist%vel,1);sizeV2=size(hist%vel,2);sizeV3=size(hist%vel,3)
404 : 4 : sizeVc1=size(hist%vel_cell,1);sizeVc2=size(hist%vel_cell,2);sizeVc3=size(hist%vel_cell,3)
405 : 4 : sizeX1=size(hist%xred,1);sizeX2=size(hist%xred,2);sizeX3=size(hist%xred,3)
406 : 4 : sizeF1=size(hist%fcart,1);sizeF2=size(hist%fcart,2);sizeF3=size(hist%fcart,3)
407 : 4 : buffer_i(1)=sizeA1 ;buffer_i(2)=sizeA2
408 : 4 : buffer_i(3)=sizeEt ;buffer_i(4)=sizeEk
409 : 4 : buffer_i(5)=sizeEnt ;buffer_i(6)=sizeT
410 : 4 : buffer_i(7)=sizeR1 ;buffer_i(8)=sizeR2
411 : 4 : buffer_i(9)=sizeR3 ;buffer_i(10)=sizeS1
412 : 4 : buffer_i(11)=sizeS2 ;buffer_i(12)=sizeV1
413 : 4 : buffer_i(13)=sizeV2 ;buffer_i(14)=sizeV3
414 : 4 : buffer_i(15)=sizeVc1;buffer_i(16)=sizeVc2
415 : 4 : buffer_i(17)=sizeVc3;buffer_i(18)=sizeX1
416 : 4 : buffer_i(19)=sizeX2 ;buffer_i(20)=sizeX3
417 : 4 : buffer_i(21)=sizeF1 ;buffer_i(22)=sizeF2
418 : 4 : buffer_i(23)=sizeF3
419 : : end if
420 : 12 : call xmpi_bcast(buffer_i,master,comm,ierr)
421 : :
422 [ + + ]: 12 : if (rank/=master) then
423 : 8 : sizeA1 =buffer_i(1) ;sizeA2 =buffer_i(2)
424 : 8 : sizeEt =buffer_i(3) ;sizeEk =buffer_i(4)
425 : 8 : sizeEnt=buffer_i(5);sizeT =buffer_i(6)
426 : 8 : sizeR1 =buffer_i(7) ;sizeR2 =buffer_i(8)
427 : 8 : sizeR3 =buffer_i(9) ;sizeS1 =buffer_i(10)
428 : 8 : sizeS2 =buffer_i(11);sizeV1 =buffer_i(12)
429 : 8 : sizeV2 =buffer_i(13);sizeV3 =buffer_i(14)
430 : 8 : sizeVc1=buffer_i(15);sizeVc2=buffer_i(16)
431 : 8 : sizeVc3=buffer_i(17);sizeX1 =buffer_i(18)
432 : 8 : sizeX2 =buffer_i(19);sizeX3 =buffer_i(20)
433 : 8 : sizeF1 =buffer_i(21);sizeF2 =buffer_i(22)
434 : 8 : sizeF3 =buffer_i(23)
435 : : end if
436 [ - + ]: 12 : ABI_FREE(buffer_i)
437 : :
438 : : !=== Broadcast reals
439 : 12 : sizeA=sizeA1*sizeA2;sizeR=sizeR1*sizeR2*sizeR3;sizeS=sizeS1*sizeS2
440 : 12 : sizeV=sizeV1*sizeV2*sizeV3;sizeVc=sizeVc1*sizeVc2*sizeVc3;
441 : 12 : sizeX=sizeX1*sizeX2*sizeX3;sizeF=sizeF1*sizeF2*sizeF3
442 : 12 : bufsize=sizeA+sizeEt+sizeEk+sizeEnt+sizeT+sizeR+sizeS+sizeV+sizeVc+sizeX+sizeF
443 [ - + + - : 36 : ABI_MALLOC(buffer_r,(bufsize))
+ - + - -
+ - + ]
444 [ + + ]: 12 : if (rank==master) then
445 : 4 : indx=0
446 [ + + ]: 8 : buffer_r(indx+1:indx+sizeA)=reshape(hist%acell(1:sizeA1,1:sizeA2),(/sizeA/))
447 : 4 : indx=indx+sizeA
448 [ + + ]: 48 : buffer_r(indx+1:indx+sizeEt)=hist%etot(1:sizeEt)
449 : 4 : indx=indx+sizeEt
450 [ + + ]: 48 : buffer_r(indx+1:indx+sizeEk)=hist%ekin(1:sizeEk)
451 : 4 : indx=indx+sizeEk
452 [ + + ]: 48 : buffer_r(indx+1:indx+sizeEnt)=hist%entropy(1:sizeEnt)
453 : 4 : indx=indx+sizeEnt
454 [ + + ]: 48 : buffer_r(indx+1:indx+sizeT)=hist%time(1:sizeT)
455 : 4 : indx=indx+sizeT
456 [ + + ]: 8 : buffer_r(indx+1:indx+sizeR)=reshape(hist%rprimd(1:sizeR1,1:sizeR2,1:sizeR3),(/sizeR/))
457 : 4 : indx=indx+sizeR
458 [ + + ]: 8 : buffer_r(indx+1:indx+sizeS)=reshape(hist%strten(1:sizeS1,1:sizeS2),(/sizeS/))
459 : 4 : indx=indx+sizeS
460 [ + + ]: 8 : buffer_r(indx+1:indx+sizeV)=reshape(hist%vel(1:sizeV1,1:sizeV2,1:sizeV3),(/sizeV/))
461 : 4 : indx=indx+sizeV
462 [ + + ]: 8 : buffer_r(indx+1:indx+sizeVc)=reshape(hist%vel_cell(1:sizeVc1,1:sizeVc2,1:sizeVc3),(/sizeVc/))
463 : 4 : indx=indx+sizeVc
464 [ + + ]: 8 : buffer_r(indx+1:indx+sizeX)=reshape(hist%xred(1:sizeX1,1:sizeX2,1:sizeX3),(/sizeX/))
465 : 4 : indx=indx+sizeX
466 [ + + ]: 8 : buffer_r(indx+1:indx+sizeF)=reshape(hist%fcart(1:sizeF1,1:sizeF2,1:sizeF3),(/sizeF/))
467 : : else
468 : 8 : call abihist_free(hist)
469 [ - + + - : 32 : ABI_MALLOC(hist%acell,(sizeA1,sizeA2))
- + + - +
- + - - +
- + - + ]
470 [ - + + - : 24 : ABI_MALLOC(hist%etot,(sizeEt))
+ - + - -
+ - + -
+ ]
471 [ - + + - : 24 : ABI_MALLOC(hist%ekin,(sizeEk))
+ - + - -
+ - + -
+ ]
472 [ - + + - : 24 : ABI_MALLOC(hist%entropy,(sizeEnt))
+ - + - -
+ - + -
+ ]
473 [ - + + - : 24 : ABI_MALLOC(hist%time,(sizeT))
+ - + - -
+ - + -
+ ]
474 [ - + + - : 40 : ABI_MALLOC(hist%rprimd,(sizeR1,sizeR2,sizeR3))
- + + - -
+ + - + -
+ - - + -
+ - + ]
475 [ - + + - : 32 : ABI_MALLOC(hist%strten,(sizeS1,sizeS2))
- + + - +
- + - - +
- + - + ]
476 [ - + + - : 40 : ABI_MALLOC(hist%vel,(sizeV1,sizeV2,sizeV3))
- + + - -
+ + - + -
+ - - + -
+ - + ]
477 [ - + + - : 40 : ABI_MALLOC(hist%vel_cell,(sizeVc1,sizeVc2,sizeVc3))
- + + - -
+ + - + -
+ - - + -
+ - + ]
478 [ - + + - : 40 : ABI_MALLOC(hist%xred,(sizeX1,sizeX2,sizeX3))
- + + - -
+ + - + -
+ - - + -
+ - + ]
479 [ - + + - : 40 : ABI_MALLOC(hist%fcart,(sizeF1,sizeF2,sizeF3))
- + + - -
+ + - + -
+ - - + -
+ - + ]
480 : : end if
481 : 12 : call xmpi_bcast(buffer_r,master,comm,ierr)
482 : :
483 [ + + ]: 12 : if (rank/=master) then
484 : 8 : indx=0
485 [ + + + + : 376 : hist%acell(1:sizeA1,1:sizeA2)=reshape(buffer_r(indx+1:indx+sizeA), (/sizeA1,sizeA2/))
+ + ]
486 : 8 : indx=indx+sizeA
487 [ + + ]: 96 : hist%etot(1:sizeEt)=buffer_r(indx+1:indx+sizeEt)
488 : 8 : indx=indx+sizeEt
489 [ + + ]: 96 : hist%ekin(1:sizeEk)=buffer_r(indx+1:indx+sizeEk)
490 : 8 : indx=indx+sizeEk
491 [ + + ]: 96 : hist%entropy(1:sizeEnt)=buffer_r(indx+1:indx+sizeEnt)
492 : 8 : indx=indx+sizeEnt
493 [ + + ]: 96 : hist%time(1:sizeT)=buffer_r(indx+1:indx+sizeT)
494 : 8 : indx=indx+sizeT
495 [ + + + + : 1176 : hist%rprimd(1:sizeR1,1:sizeR2,1:sizeR3)=reshape(buffer_r(indx+1:indx+sizeR), (/sizeR1,sizeR2,sizeR3/))
+ + + + ]
496 : 8 : indx=indx+sizeR
497 [ + + + + : 640 : hist%strten(1:sizeS1,1:sizeS2)=reshape(buffer_r(indx+1:indx+sizeS), (/sizeS1,sizeS2/))
+ + ]
498 : 8 : indx=indx+sizeS
499 [ + + + + : 14200 : hist%vel(1:sizeV1,1:sizeV2,1:sizeV3)=reshape(buffer_r(indx+1:indx+sizeV), (/sizeV1,sizeV2,sizeV3/))
+ + + + ]
500 : 8 : indx=indx+sizeV
501 [ + + + + : 1176 : hist%vel_cell(1:sizeVc1,1:sizeVc2,1:sizeVc3)=reshape(buffer_r(indx+1:indx+sizeVc), (/sizeVc1,sizeVc2,sizeVc3/))
+ + + + ]
502 : 8 : indx=indx+sizeVc
503 [ + + + + : 14200 : hist%xred(1:sizeX1,1:sizeX2,1:sizeX3)=reshape(buffer_r(indx+1:indx+sizeX), (/sizeX1,sizeX2,sizeX3/))
+ + + + ]
504 : 8 : indx=indx+sizeX
505 [ + + + + : 14200 : hist%fcart(1:sizeF1,1:sizeF2,1:sizeF3)=reshape(buffer_r(indx+1:indx+sizeF), (/sizeF1,sizeF2,sizeF3/))
+ + + + ]
506 : : end if
507 [ - + ]: 12 : ABI_FREE(buffer_r)
508 : :
509 [ + - ]: 65 : end subroutine abihist_bcast_0D
510 : : !!***
511 : :
512 : : !----------------------------------------------------------------------
513 : :
514 : : !!****f* m_abihist/abihist_bcast_1D
515 : : !! NAME
516 : : !! abihist_bcast_1D
517 : : !!
518 : : !! FUNCTION
519 : : !! Broadcast a hist datastructure (from a root process to all others) - Target: 1D array
520 : : !!
521 : : !! INPUTS
522 : : !! master=ID of the sending node in comm
523 : : !! comm=MPI Communicator
524 : : !!
525 : : !! SOURCE
526 : :
527 [ - + ]: 1 : subroutine abihist_bcast_1D(hist,master,comm)
528 : :
529 : : !Arguments ------------------------------------
530 : : !scalars
531 : : integer,intent(in) :: master,comm
532 : : type(abihist),intent(inout) :: hist(:)
533 : :
534 : : !Local variables-------------------------------
535 : : integer :: ii
536 : : ! ***************************************************************
537 : :
538 [ + + ]: 6 : do ii=1,size(hist)
539 : 6 : call abihist_bcast_0D(hist(ii),master,comm)
540 : : end do
541 : :
542 : 1 : end subroutine abihist_bcast_1D
543 : : !!***
544 : :
545 : : !----------------------------------------------------------------------
546 : :
547 : : !!****f* m_abihist/var2hist
548 : : !!
549 : : !! NAME
550 : : !! var2hist
551 : : !!
552 : : !! FUNCTION
553 : : !! Set the values of the history "hist" with the values of xred, acell and rprimd
554 : : !!
555 : : !! INPUTS
556 : : !! natom = number of atoms
557 : : !! xred(3,natom) = reduced dimensionless atomic coordinates
558 : : !! acell(3) = length scales of primitive translations (bohr)
559 : : !! rprimd(3,3) = dimensionlal real space primitive translations (bohr)
560 : : !!
561 : : !! OUTPUT
562 : : !!
563 : : !! SIDE EFFECTS
564 : : !! hist<type abihist>=Historical record of positions, forces, acell, stresses, and energies,
565 : : !!
566 : : !! SOURCE
567 : :
568 : 13686 : subroutine var2hist(acell,hist,natom,rprimd,xred,zDEBUG)
569 : :
570 : : !Arguments ------------------------------------
571 : : !scalars
572 : : class(abihist),intent(inout) :: hist
573 : : integer,intent(in) :: natom
574 : : logical,intent(in) :: zDEBUG
575 : : !arrays
576 : : real(dp),intent(in) :: acell(3)
577 : : real(dp),intent(in) :: rprimd(3,3)
578 : : real(dp),intent(in) :: xred(3,natom)
579 : :
580 : : !Local variables-------------------------------
581 : : integer :: kk
582 : : ! *************************************************************
583 : :
584 [ + + + + ]: 35558890 : hist%xred(:,:,hist%ihist)=xred(:,:)
585 [ + + + + ]: 177918 : hist%rprimd(:,:,hist%ihist)=rprimd(:,:)
586 [ + + ]: 54744 : hist%acell(:,hist%ihist)=acell(:)
587 : :
588 [ - + ]: 13686 : if(zDEBUG)then
589 : 0 : write (std_out,*) 'Atom positions and cell parameters '
590 : 0 : write (std_out,*) 'ihist: ',hist%ihist
591 : 0 : write (std_out,*) 'xred:'
592 [ # # ]: 0 : do kk=1,natom
593 : 0 : write (std_out,*) xred(:,kk)
594 : : end do
595 : 0 : write(std_out,*) 'rprimd:'
596 [ # # ]: 0 : do kk=1,3
597 : 0 : write(std_out,*) rprimd(:,kk)
598 : : end do
599 : 0 : write(std_out,*) 'acell:'
600 : 0 : write(std_out,*) acell(:)
601 : : end if
602 : :
603 : 13686 : end subroutine var2hist
604 : : !!***
605 : :
606 : : !!****f* m_abihist/abihist_findIndex
607 : : !!
608 : : !! NAME
609 : : !! abihist_findIndex
610 : : !!
611 : : !! FUNCTION
612 : : !!
613 : : !! INPUTS
614 : : !! hist<type abihist>=Historical record of positions, forces, acell, stresses, and energies
615 : : !! step = value of the needed step
616 : : !!
617 : : !! OUTPUT
618 : : !! index = index of the step in the hist file
619 : : !!
620 : : !! SOURCE
621 : :
622 : 16423 : function abihist_findIndex(hist,step) result(index)
623 : :
624 : : !Arguments ------------------------------------
625 : : !scalars
626 : : class(abihist),intent(in) :: hist
627 : : integer,intent(in) :: step
628 : : integer :: index
629 : :
630 : : !Local variables-------------------------------
631 : : integer :: ii,mxhist
632 : : character(len=500) :: msg
633 : : ! *************************************************************
634 : :
635 : 16423 : mxhist = hist%mxhist
636 : :
637 [ - + - - : 16423 : if ((mxhist ==1.and.step/=+1) .or. (mxhist /=1.and.abs(step) >=mxhist)) then
+ - - + ]
638 : 0 : write(msg,'(a,I0,2a)')' The requested step must be less than ',mxhist,ch10,&
639 : 0 : 'Action: increase the number of history stored in the history'
640 : 0 : ABI_BUG(msg)
641 : : end if
642 : :
643 : 16423 : ii = hist%ihist + step
644 : :
645 [ + + ]: 19987 : do while (ii > mxhist)
646 : 19987 : ii = ii - mxhist
647 : : end do
648 [ + + ]: 18057 : do while (ii <= 0)
649 : 1634 : ii = ii + mxhist
650 : : end do
651 : :
652 : 16423 : index = ii
653 : :
654 : 16423 : end function abihist_findIndex
655 : : !!***
656 : :
657 : : !----------------------------------------------------------------------
658 : :
659 : : !!****f* m_abihist/hist2var
660 : : !! NAME
661 : : !! hist2var
662 : : !!
663 : : !! FUNCTION
664 : : !! Return the last values of xred, acell and rprimd stored in the history.
665 : : !!
666 : : !! INPUTS
667 : : !! natom = Number of atoms
668 : : !! hist<type abihist>=Historical record of positions, forces, acell, stresses, and energies,
669 : : !! zDebug = If true some output will be printed
670 : : !!
671 : : !! OUTPUT
672 : : !! xred(3,natom) = reduced dimensionless atomic coordinates
673 : : !! acell(3) = length scales of primitive translations (bohr)
674 : : !! rprimd(3,3) = dimensional real space primitive translations (bohr)
675 : : !!
676 : : !! SOURCE
677 : :
678 : 42217 : subroutine hist2var(acell,hist,natom,rprimd,xred,zDEBUG)
679 : :
680 : : !Arguments ------------------------------------
681 : : !scalars
682 : : integer,intent(in) :: natom
683 : : class(abihist),intent(in) :: hist
684 : : logical,intent(in) :: zDEBUG
685 : : !arrays
686 : : real(dp),intent(out) :: acell(3)
687 : : real(dp),intent(out) :: rprimd(3,3)
688 : : real(dp),intent(out) :: xred(3,natom)
689 : :
690 : : !Local variables-------------------------------
691 : : integer :: kk
692 : : ! *************************************************************
693 : :
694 [ + + + + ]: 141120185 : xred (:,:)=hist%xred(:,:,hist%ihist)
695 [ + + ]: 168868 : acell (: )=hist%acell(:,hist%ihist)
696 [ + + + + ]: 548821 : rprimd(:,:)=hist%rprimd(:,:,hist%ihist)
697 : :
698 [ - + ]: 42217 : if(zDEBUG)then
699 : 0 : write (std_out,*) 'Atom positions and cell parameters '
700 : 0 : write (std_out,*) 'ihist: ',hist%ihist
701 : 0 : write (std_out,*) 'xred:'
702 [ # # ]: 0 : do kk=1,natom
703 : 0 : write (std_out,*) xred(:,kk)
704 : : end do
705 : 0 : write(std_out,*) 'rprimd:'
706 [ # # ]: 0 : do kk=1,3
707 : 0 : write(std_out,*) rprimd(:,kk)
708 : : end do
709 : 0 : write(std_out,*) 'acell:'
710 : 0 : write(std_out,*) acell(:)
711 : : end if
712 : :
713 : 42217 : end subroutine hist2var
714 : : !!***
715 : :
716 : : !----------------------------------------------------------------------
717 : :
718 : : !!****f* m_abihist/vel2hist
719 : : !!
720 : : !! NAME
721 : : !! vel2hist
722 : : !!
723 : : !! FUNCTION
724 : : !! Set the values of the history "hist" related with velocities, ie
725 : : !! The array of velocities and Kinetic Energy
726 : : !!
727 : : !! INPUTS
728 : : !! amass(natom) = mass of the atoms
729 : : !! vel(3,natom)= Velocities of the atoms
730 : : !! vel_cell(3,3)= Velocities of the cell
731 : : !!
732 : : !! SIDE EFFECTS
733 : : !! hist<type abihist>=Historical record of positions, forces, stresses, cell and energies,
734 : : !!
735 : : !! SOURCE
736 : :
737 [ - + - + : 14232 : subroutine vel2hist(amass,hist,vel,vel_cell)
- + ]
738 : :
739 : : !Arguments ------------------------------------
740 : : !scalars
741 : : class(abihist),intent(inout) :: hist
742 : : !arrays
743 : : real(dp),intent(in) :: amass(:)
744 : : real(dp),intent(in) :: vel(:,:)
745 : : real(dp),intent(in) :: vel_cell(:,:)
746 : :
747 : : !Local variables-------------------------------
748 : : !scalars
749 : : integer :: ii,natom
750 : : real(dp) :: ekin
751 : : ! *************************************************************
752 : :
753 : 14232 : natom=size(vel,2)
754 : :
755 [ + + ]: 14232 : if (hist%isVused) then
756 : :
757 : : ! Store the velocities
758 [ + + + + ]: 35527207 : hist%vel(:,:,hist%ihist)=vel(:,:)
759 [ + + + + ]: 139451 : hist%vel_cell(:,:,hist%ihist)=vel_cell(:,:)
760 : :
761 : : ! Compute the Ionic Kinetic energy
762 : : ekin=zero
763 [ + + ]: 8889847 : do ii=1,natom
764 [ + + ]: 35527207 : ekin = ekin + half * amass(ii) * DOT_PRODUCT(vel(:, ii), vel(:, ii))
765 : : end do
766 : :
767 : : else
768 [ + + + + ]: 38265 : hist%vel(:,:,hist%ihist)=zero
769 [ + + + + ]: 45565 : hist%vel_cell(:,:,hist%ihist)=zero
770 : : ekin=zero
771 : : end if
772 : :
773 : : !Store the Ionic Kinetic Energy
774 : 14232 : hist%ekin(hist%ihist)=ekin
775 : :
776 : 14232 : end subroutine vel2hist
777 : : !!***
778 : :
779 : : !----------------------------------------------------------------------
780 : :
781 : : !!****f* m_abihist/abihist_copy
782 : : !! NAME
783 : : !! abihist_copy
784 : : !!
785 : : !! FUNCTION
786 : : !! Copy one HIST record in another
787 : : !!
788 : : !! SOURCE
789 : :
790 : 1007 : subroutine abihist_copy(hist_in, hist_out)
791 : :
792 : : !Arguments ------------------------------------
793 : : !scalars
794 : : class(abihist),intent(in) :: hist_in
795 : : class(abihist),intent(inout) :: hist_out
796 : : ! ***************************************************************
797 : :
798 : : !Check
799 [ - + ]: 1007 : if (size(hist_in%xred,2)/=size(hist_out%xred,2)) then
800 : 0 : ABI_BUG('Incompatible sizes for hist_in and hist_out!')
801 : : end if
802 : :
803 : : !Copy scalars (except ihist and mxhist)
804 : 1007 : hist_out%isVused =hist_in%isVused
805 : 1007 : hist_out%isARused =hist_in%isARused
806 : :
807 : : !Copy arrays
808 [ + + ]: 4028 : hist_out%acell(:,hist_out%ihist) = hist_in%acell(:,hist_in%ihist)
809 [ + + + + ]: 13091 : hist_out%rprimd(:,:,hist_out%ihist) = hist_in%rprimd(:,:,hist_in%ihist)
810 [ + + + + ]: 158727 : hist_out%xred(:,:,hist_out%ihist) = hist_in%xred(:,:,hist_in%ihist)
811 [ + + + + ]: 158727 : hist_out%fcart(:,:,hist_out%ihist) = hist_in%fcart(:,:,hist_in%ihist)
812 [ + + ]: 7049 : hist_out%strten(:,hist_out%ihist) = hist_in%strten(:,hist_in%ihist)
813 [ + + + + ]: 158727 : hist_out%vel(:,:,hist_out%ihist) = hist_in%vel(:,:,hist_in%ihist)
814 [ + + + + ]: 13091 : hist_out%vel_cell(:,:,hist_out%ihist)= hist_in%vel_cell(:,:,hist_in%ihist)
815 : 1007 : hist_out%etot(hist_out%ihist) = hist_in%etot(hist_in%ihist)
816 : 1007 : hist_out%ekin(hist_out%ihist) = hist_in%ekin(hist_in%ihist)
817 : 1007 : hist_out%entropy(hist_out%ihist) = hist_in%entropy(hist_in%ihist)
818 : 1007 : hist_out%time(hist_out%ihist) = hist_in%time(hist_in%ihist)
819 : :
820 : 1007 : end subroutine abihist_copy
821 : : !!***
822 : :
823 : : !----------------------------------------------------------------------
824 : :
825 : : !!****f* m_abihist/abihist_compare_and_copy
826 : : !! NAME
827 : : !! abihist_compare
828 : : !!
829 : : !! FUNCTION
830 : : !! Compare 2 HIST records
831 : : !!
832 : : !! INPUTS
833 : : !! hist_in <type(abihist)>
834 : : !! tolerance
835 : : !! store_all = flag to know if we need to increment ihist (store all the history)
836 : : !! or just call shift (store just the last step)
837 : : !!
838 : : !! OUTPUT
839 : : !! similar= 1 the records are consistent
840 : : !! 0 the records are not consistent
841 : : !!
842 : : !! SIDE EFFECTS
843 : : !! hist_out <type(abihist)>
844 : : !!
845 : : !! SOURCE
846 : :
847 : 2 : subroutine abihist_compare_and_copy(hist_in,hist_out,natom,similar,tolerance,store_all,force_copy)
848 : :
849 : : !Arguments ------------------------------------
850 : : !scalars
851 : : integer,intent(in) :: natom
852 : : integer,intent(out) :: similar
853 : : real(dp),intent(in) :: tolerance
854 : : class(abihist),intent(in) :: hist_in
855 : : class(abihist),intent(inout) :: hist_out
856 : : logical,intent(in) :: force_copy,store_all
857 : :
858 : : !Local variables-------------------------------
859 : : !scalars
860 : : integer :: kk,jj
861 : : real(dp) :: maxdiff,diff, x,y
862 : : !array
863 : : character(len= 500) :: msg
864 : : ! ***************************************************************
865 : :
866 : : ABI_UNUSED(store_all)
867 : :
868 : 2 : similar=1
869 : :
870 : 2 : write(msg,'(a,I0,4a)') 'Using values from history, iteration:',hist_in%ihist,ch10,&
871 : 2 : & 'Differences between present history and values stored',ch10,&
872 : 4 : & 'on the previous history.(Relative difference)'
873 : 2 : call wrtout(std_out,msg,'COLL')
874 : :
875 : 2 : maxdiff = -1.0
876 [ + + ]: 10 : do kk=1,natom
877 [ + + ]: 34 : do jj=1,3
878 : 24 : x=hist_out%xred(jj,kk,hist_out%ihist)
879 : 24 : y=hist_in%xred(jj,kk,hist_in%ihist)
880 : 24 : diff = zero
881 [ + + + - ]: 24 : if (abs(x) > tol12 .and. abs(y) > tol12) then
882 : 18 : diff=2*abs(x-y)/(abs(x)+abs(y))
883 : : end if
884 [ + + ]: 32 : if (diff>maxdiff) maxdiff=diff
885 : : end do
886 : : end do
887 : 2 : write(msg,'(a,e12.5)') 'xred: ',maxdiff
888 : 2 : call wrtout(std_out,msg,'COLL')
889 : :
890 [ - + ]: 2 : if (maxdiff>tolerance) similar=0
891 : :
892 : 2 : maxdiff = -1.0
893 [ + + ]: 8 : do kk=1,3
894 [ + + ]: 26 : do jj=1,3
895 : 18 : x=hist_out%rprimd(jj,kk,hist_out%ihist)
896 : 18 : y=hist_in%rprimd(jj,kk,hist_in%ihist)
897 : 18 : diff = zero
898 [ + + + - ]: 18 : if (abs(x) > tol12 .and. abs(y) > tol12) then
899 : 6 : diff=2*abs(x-y)/(abs(x)+abs(y))
900 : : end if
901 [ + + ]: 24 : if (diff>maxdiff) maxdiff=diff
902 : : end do
903 : : end do
904 : 2 : write(msg,'(a,e12.5)') 'rprimd: ',maxdiff
905 : 2 : call wrtout(std_out,msg,'COLL')
906 [ - + ]: 2 : if (maxdiff>tolerance) similar=0
907 : :
908 : :
909 : 2 : maxdiff = -1.0
910 [ + + ]: 8 : do kk=1,3
911 : 6 : x=hist_out%acell(kk,hist_out%ihist)
912 : 6 : y=hist_in%acell(kk,hist_in%ihist)
913 : 6 : diff=2*abs(x-y)/(abs(x)+abs(y))
914 [ + + ]: 8 : if (diff>maxdiff) maxdiff=diff
915 : : end do
916 : 2 : write(msg,'(a,e12.5)') 'acell: ',maxdiff
917 : 2 : call wrtout(std_out,msg,'COLL')
918 [ - + ]: 2 : if (maxdiff>tolerance) similar=0
919 : :
920 [ - + - - ]: 2 : if (similar==1.or.force_copy) then
921 [ + + ]: 8 : hist_out%acell(:,hist_out%ihist) =hist_in%acell(:,hist_in%ihist)
922 [ + + + + ]: 26 : hist_out%rprimd(:,:,hist_out%ihist) =hist_in%rprimd(:,:,hist_in%ihist)
923 [ + + + + ]: 34 : hist_out%xred(:,:,hist_out%ihist) =hist_in%xred(:,:,hist_in%ihist)
924 [ + + + + ]: 34 : hist_out%fcart(:,:,hist_out%ihist) =hist_in%fcart(:,:,hist_in%ihist)
925 [ + + ]: 14 : hist_out%strten(:,hist_out%ihist) =hist_in%strten(:,hist_in%ihist)
926 [ + + + + ]: 34 : hist_out%vel(:,:,hist_out%ihist) =hist_in%vel(:,:,hist_in%ihist)
927 [ + + + + ]: 26 : hist_out%vel_cell(:,:,hist_out%ihist)=hist_in%vel_cell(:,:,hist_in%ihist)
928 : 2 : hist_out%etot(hist_out%ihist) =hist_in%etot(hist_in%ihist)
929 : 2 : hist_out%ekin(hist_out%ihist) =hist_in%ekin(hist_in%ihist)
930 : 2 : hist_out%entropy(hist_out%ihist) =hist_in%entropy(hist_in%ihist)
931 : 2 : hist_out%time(hist_out%ihist) =hist_in%time(hist_in%ihist)
932 : : end if
933 : :
934 : 2 : end subroutine abihist_compare_and_copy
935 : : !!***
936 : :
937 : : !----------------------------------------------------------------------
938 : :
939 : : !!****f* m_abihist/write_md_hist
940 : : !!
941 : : !! NAME
942 : : !! write_md_hist
943 : : !!
944 : : !! FUNCTION
945 : : !! Write the history file into a netcdf file
946 : : !! This version is not compatible with multiple images.
947 : : !!
948 : : !! INPUTS
949 : : !! filname=filename of the file where the history will be stored
950 : : !! hist<type abihist>=Historical record of positions, forces, stresses, cell dims and energies,
951 : : !! ifirst=1 if first access to the file
952 : : !! itime = index of the step in the hist file
953 : : !! natom=Number of atoms.
954 : : !! nctime=NetCdf TIME between output of molecular dynamics information
955 : : !! ntypat=Number of type of atoms.
956 : : !! typat(natom)=Type of each natom
957 : : !! amu(ntypat)=mass of the atoms (atomic mass unit)
958 : : !! znucl(:)=Nuclear charge for each type of pseudopotential.
959 : : !! WARNING: alchemical mixing is not supported. We assume npsp == ntypat
960 : : !! dtion=time step for Molecular Dynamics
961 : : !!
962 : : !! TODO
963 : : !! Have you ever heard about ETSF-IO specifications?
964 : : !!
965 : : !! OUTPUT
966 : : !! (only writing)
967 : : !!
968 : : !! SOURCE
969 : :
970 : 10394 : subroutine write_md_hist(hist,filename,ifirst,itime,natom,nctime,ntypat,&
971 [ - + ]: 10394 : typat,amu,znucl,dtion,mdtemp)
972 : :
973 : : !Arguments ------------------------------------
974 : : !scalars
975 : : class(abihist),intent(inout),target :: hist
976 : : integer,intent(in) :: ifirst,itime,natom,nctime,ntypat
977 : : real(dp),intent(in) :: dtion
978 : : character(len=*),intent(in) :: filename
979 : : !arrays
980 : : integer,intent(in) :: typat(natom)
981 : : real(dp),intent(in) :: amu(ntypat),znucl(:),mdtemp(2)
982 : :
983 : : !Local variables-------------------------------
984 : : !scalars
985 : : integer :: itime_file,ncerr,ncid,npsp
986 : : integer :: xcart_id,xred_id,fcart_id,gred_id
987 : : integer :: vel_id,vel_cell_id,etotal_id,acell_id,rprimd_id,strten_id
988 : : integer :: ekin_id,entropy_id,mdtime_id
989 : : logical :: has_nimage=.false.,need_to_write
990 : : integer, parameter :: imgmov=0
991 : : ! *************************************************************************
992 : :
993 : 10394 : need_to_write = .FALSE.
994 [ + + + + ]: 10394 : if(nctime==0 .or. ifirst==1) need_to_write = .TRUE.
995 [ + + + + ]: 10394 : if (itime > nctime .and. nctime /= 0) then
996 [ + + ]: 8972 : if (mod(itime,nctime) == 0) need_to_write = .TRUE.
997 : : end if
998 : : !Return if we don't need to write the HIST file at this step
999 [ + + ]: 9253 : if (.not. need_to_write) return
1000 : :
1001 [ + + ]: 2478 : if (ifirst==1) then
1002 : : !##### First access: Create NetCDF file and write defs
1003 : :
1004 : 298 : write(std_out,*) 'Write iteration in HIST netCDF file (also create it)'
1005 : 298 : npsp=size(znucl)
1006 : :
1007 : : ! Create netCDF file
1008 : 298 : ncerr = nf90_create(path=trim(filename),cmode=NF90_CLOBBER,ncid=ncid)
1009 [ - + ]: 298 : NCF_CHECK_MSG(ncerr," create netcdf history file")
1010 : :
1011 : : ! Define all dims and vars
1012 : 298 : call def_file_hist(ncid,natom,1,ntypat,npsp,has_nimage)
1013 : :
1014 : : ! Write variables that do not change
1015 : : ! (they are not read in a hist structure).
1016 : 298 : call write_csts_hist(ncid,dtion,imgmov,typat,znucl,amu,mdtemp,hist%ndof)
1017 : :
1018 : : ! Compute the itime for the hist file
1019 : 298 : itime_file = 1
1020 : : else
1021 : : !##### itime>2 access: just open NetCDF file
1022 : :
1023 : : if(need_to_write) then
1024 : :
1025 : 2180 : write(std_out,*) 'Write iteration in HIST netCDF file'
1026 : :
1027 : : ! Open netCDF file
1028 : 2180 : ncerr = nf90_open(path=trim(filename),mode=NF90_WRITE, ncid=ncid)
1029 [ - + ]: 2180 : NCF_CHECK_MSG(ncerr," open netcdf history file")
1030 : :
1031 : : ! Compute the itime for the hist file
1032 : 2180 : itime_file = itime
1033 [ + + ]: 2180 : if(nctime > 0) itime_file = int(anint(real(itime / nctime,sp)))
1034 : :
1035 : : end if
1036 : : endif
1037 : :
1038 : 2478 : if(need_to_write) then
1039 : : !##### Write variables into the dataset
1040 : : !Get the IDs
1041 : : call get_varid_hist(ncid,xcart_id,xred_id,fcart_id,gred_id,vel_id,vel_cell_id,&
1042 : 2478 : & rprimd_id,acell_id,strten_id,etotal_id,ekin_id,entropy_id,mdtime_id,has_nimage)
1043 : : !Write
1044 : : call write_vars_hist(ncid,hist,natom,has_nimage,1,itime_file,&
1045 : : & xcart_id,xred_id,fcart_id,gred_id,vel_id,vel_cell_id,&
1046 : 2478 : & rprimd_id,acell_id,strten_id,etotal_id,ekin_id,entropy_id,mdtime_id)
1047 : :
1048 : : !##### Close the file
1049 : 2478 : ncerr = nf90_close(ncid)
1050 [ - + ]: 2478 : NCF_CHECK_MSG(ncerr," close netcdf history file")
1051 : : end if
1052 : :
1053 : : end subroutine write_md_hist
1054 : : !!***
1055 : :
1056 : : !----------------------------------------------------------------------
1057 : :
1058 : : !!****f* m_abihist/write_md_hist_img
1059 : : !!
1060 : : !! NAME
1061 : : !! write_md_hist_img
1062 : : !!
1063 : : !! FUNCTION
1064 : : !! Write the history file into a netcdf file
1065 : : !! This version is compatible with multiple images of the
1066 : : !!
1067 : : !! INPUTS
1068 : : !! filname= filename of the file where the history will be stored
1069 : : !! hist(:)<type abihist>= Historical record of positions, forces, stresses, cell dims and energies,
1070 : : !! Size(hist) is equal to a number of images to be written
1071 : : !! ifirst= 1 if first access to the file
1072 : : !! itime = index of the step in the hist file
1073 : : !! natom= Number of atoms.
1074 : : !! ntypat= Number of type of atoms.
1075 : : !! typat(natom)= Type of each natom
1076 : : !! amu(ntypat)= Mass of the atoms (atomic mass unit)
1077 : : !! znucl(:)= Nuclear charge for each type of pseudopotential.
1078 : : !! WARNING: alchemical mixing is not supported. We assume npsp == ntypat
1079 : : !! dtion= Time step for Molecular Dynamics
1080 : : !! [nimage]= Total number of images of the cell
1081 : : !! [comm_img]= MPI communicator over images of the cell
1082 : : !! [imgtab(:)]= In case of multiple images, indexes of images to be read
1083 : : !! Default is 1,2,3,...
1084 : : !! Size must be equal to size(hist)
1085 : : !!
1086 : : !! TODO
1087 : : !! Have you ever heard about ETSF-IO specifications?
1088 : : !!
1089 : : !! OUTPUT
1090 : : !! (only writing)
1091 : : !!
1092 : : !! SOURCE
1093 : :
1094 [ - + ]: 225 : subroutine write_md_hist_img(hist,filename,ifirst,itime,natom,ntypat,&
1095 [ - + ]: 225 : & typat,amu,znucl,dtion,&
1096 [ + - + - : 225 : & nimage,imgmov,mdtemp,comm_img,imgtab) ! optional arguments
- + ]
1097 : :
1098 : : !Arguments ------------------------------------
1099 : : !scalars
1100 : : integer,intent(in) :: ifirst,itime,natom,ntypat
1101 : : integer,intent(in),optional :: nimage,imgmov,comm_img
1102 : : real(dp),intent(in) :: dtion
1103 : : character(len=*),intent(in) :: filename
1104 : : !arrays
1105 : : integer,intent(in) :: typat(natom)
1106 : : integer,intent(in),optional :: imgtab(:)
1107 : : real(dp),intent(in) :: amu(ntypat),znucl(:),mdtemp(2)
1108 : : type(abihist),intent(inout),target :: hist(:)
1109 : :
1110 : : !Local variables-------------------------------
1111 : : !scalars
1112 : : integer :: ii,iimage,iimg,me_img,my_comm_img,my_nimage,ncerr
1113 : : integer :: ncid,nimage_,nproc_img,npsp,imgmov_
1114 : : integer :: xcart_id,xred_id,fcart_id,gred_id
1115 : : integer :: vel_id,vel_cell_id,etotal_id
1116 : : integer :: acell_id,rprimd_id,strten_id
1117 : : integer :: ekin_id,entropy_id,mdtime_id
1118 : : logical :: has_nimage, has_imgmov
1119 : : !character(len=500) :: msg
1120 : : type(abihist),pointer :: hist_
1121 : : !arrays
1122 : 225 : integer,allocatable :: my_imgtab(:)
1123 : : ! *************************************************************************
1124 : :
1125 : : !Manage multiple images of the cell
1126 : 225 : has_nimage=present(nimage)
1127 : 225 : has_imgmov=present(imgmov)
1128 : 225 : nimage_=merge(nimage,1,has_nimage)
1129 : 225 : imgmov_=merge(imgmov,0,has_imgmov)
1130 [ - + ]: 225 : my_nimage=size(hist) ; if (my_nimage==0) return
1131 [ + - ]: 225 : my_comm_img=xmpi_comm_self;if(present(comm_img)) my_comm_img=comm_img
1132 : 225 : nproc_img=xmpi_comm_size(my_comm_img)
1133 : 225 : me_img=xmpi_comm_rank(my_comm_img)
1134 [ - + + - : 675 : ABI_MALLOC(my_imgtab,(my_nimage))
+ - + - -
+ - + ]
1135 [ + - ]: 225 : if (present(imgtab)) then
1136 [ - + ]: 225 : if (size(my_imgtab)/=my_nimage) then
1137 : 0 : ABI_BUG('Inconsistency between hist and imgtab!')
1138 : : end if
1139 [ + + ]: 1579 : my_imgtab(:)=imgtab(:)
1140 : : else
1141 [ # # # # : 0 : my_imgtab(:)=(/(iimage,iimage=1,my_nimage)/)
# # ]
1142 : : end if
1143 : :
1144 : : !Has to access the HIST file sequentially, proc by proc
1145 [ + + ]: 450 : do ii=0,nproc_img-1
1146 : 225 : call xmpi_barrier(my_comm_img)
1147 [ + - ]: 450 : if (me_img==ii) then
1148 : :
1149 : : ! ##### First access: Create NetCDF file and write defs
1150 [ + + + - ]: 225 : if (ifirst==1.and.me_img==0) then
1151 : 30 : npsp=size(znucl)
1152 : : ! Create netCDF file
1153 : 30 : ncerr = nf90_create(path=trim(filename),cmode=NF90_CLOBBER,ncid=ncid)
1154 [ - + ]: 30 : NCF_CHECK_MSG(ncerr," create netcdf history file")
1155 : : ! Define all dims and vars
1156 : 30 : call def_file_hist(ncid,natom,nimage_,ntypat,npsp,has_nimage)
1157 : : ! Write variables that do not change
1158 : : ! (they are not read in a hist structure).
1159 : 30 : call write_csts_hist(ncid,dtion,imgmov_,typat,znucl,amu,mdtemp,hist(1)%ndof)
1160 : : end if
1161 : :
1162 : : ! ##### itime>2 access: just open NetCDF file
1163 [ + + - + ]: 225 : if (ifirst/=1.or.me_img/=0) then
1164 : : ! Open netCDF file
1165 : 195 : ncerr = nf90_open(path=trim(filename),mode=NF90_WRITE, ncid=ncid)
1166 [ - + ]: 195 : NCF_CHECK_MSG(ncerr," open netcdf history file")
1167 : : end if
1168 : :
1169 : 225 : write(std_out,*) 'Write iteration in HIST netCDF file'
1170 : :
1171 : : ! ##### Write variables into the dataset (loop over images)
1172 : : ! Get the IDs
1173 : : call get_varid_hist(ncid,xcart_id,xred_id,fcart_id,gred_id,vel_id,vel_cell_id,&
1174 : 225 : & rprimd_id,acell_id,strten_id,etotal_id,ekin_id,entropy_id,mdtime_id,has_nimage)
1175 : :
1176 : : ! Write
1177 [ + + ]: 1579 : do iimage=1,my_nimage
1178 : 1354 : iimg=my_imgtab(iimage)
1179 : 1354 : hist_ => hist(iimage)
1180 : : call write_vars_hist(ncid,hist_,natom,has_nimage,iimg,itime,&
1181 : : & xcart_id,xred_id,fcart_id,gred_id,vel_id,vel_cell_id,&
1182 : 1579 : & rprimd_id,acell_id,strten_id,etotal_id,ekin_id,entropy_id,mdtime_id)
1183 : : end do
1184 : :
1185 : : ! ##### Close the file
1186 : 225 : ncerr = nf90_close(ncid)
1187 [ - + ]: 225 : NCF_CHECK_MSG(ncerr," close netcdf history file")
1188 [ - + ]: 225 : ABI_FREE(my_imgtab)
1189 : :
1190 : : ! End loop on MPI processes
1191 : : end if
1192 : : end do
1193 : :
1194 [ - + ]: 225 : end subroutine write_md_hist_img
1195 : : !!***
1196 : :
1197 : : !----------------------------------------------------------------------
1198 : :
1199 : : !!****f* m_abihist/read_md_hist
1200 : : !!
1201 : : !! NAME
1202 : : !! read_md_hist
1203 : : !!
1204 : : !! FUNCTION
1205 : : !! Read the history file from a netcdf file and store it into a hist dataset structure
1206 : : !! This version is not compatible with multiple images of the simulation cell.
1207 : : !!
1208 : : !! INPUTS
1209 : : !! filename = Filename of the NetCDF to read
1210 : : !! isVUsed,isARUsed=flags used to initialize hist structure
1211 : : !!
1212 : : !! OUTPUT
1213 : : !! hist<type abihist>=Historical record of positions, forces, stresses, cell dims and energies,
1214 : : !!
1215 : : !! SOURCE
1216 : :
1217 : 86 : subroutine read_md_hist(filename,hist,isVUsed,isARUsed,readOnlyLast)
1218 : :
1219 : : !Arguments ------------------------------------
1220 : : !scalars
1221 : : class(abihist),intent(inout),target :: hist
1222 : : logical,intent(in) :: isVUsed,isARUsed,readOnlyLast
1223 : : character(len=*),intent(in) :: filename
1224 : :
1225 : : !Local variables-------------------------------
1226 : : !scalars
1227 : : integer :: ncerr,ncid,nimage,natom,time,start_time, ntypat
1228 : : integer :: nimage_id,natom_id,xyz_id,time_id,six_id, ntypat_id
1229 : : integer :: xcart_id,xred_id,fcart_id,gred_id,ekin_id,entropy_id
1230 : : integer :: mdtime_id,vel_id,vel_cell_id,etotal_id
1231 : : integer :: acell_id,rprimd_id,strten_id
1232 : : logical :: has_nimage
1233 : : ! *************************************************************************
1234 : :
1235 : 36 : hist%ihist=0 ; hist%mxhist=0
1236 : :
1237 : : !Open netCDF file
1238 : 36 : ncerr=nf90_open(path=trim(filename),mode=NF90_NOWRITE,ncid=ncid)
1239 [ + + ]: 36 : if(ncerr /= NF90_NOERR) then
1240 : 11 : write(std_out,*) 'Could no open ',trim(filename),', starting from scratch'
1241 : 11 : return
1242 : : else
1243 : 25 : write(std_out,*) 'Succesfully open ',trim(filename),' for reading'
1244 : 25 : write(std_out,*) 'Extracting information from NetCDF file...'
1245 : : end if
1246 : :
1247 : : !Inquire dimensions IDs and lengths
1248 : : call get_dims_hist(ncid,natom,ntypat,nimage,time,&
1249 : 25 : & natom_id,ntypat_id,nimage_id,time_id,xyz_id,six_id,has_nimage)
1250 : :
1251 : : !If only the last step is needing (restarxf==-3 for example)
1252 [ + + ]: 25 : if(readOnlyLast)then
1253 : 4 : start_time = time
1254 : 4 : time = 1
1255 : : else
1256 : 21 : start_time = 1
1257 : : end if
1258 : :
1259 : : !Allocate hist structure
1260 : 25 : call abihist_init(hist,natom,time,isVused,isARused)
1261 : :
1262 : : !Get the ID of a variables from their name
1263 : : call get_varid_hist(ncid,xcart_id,xred_id,fcart_id,gred_id,vel_id,vel_cell_id,&
1264 : 25 : & rprimd_id,acell_id,strten_id,etotal_id,ekin_id,entropy_id,mdtime_id,has_nimage)
1265 : :
1266 : : !Read variables from the dataset and write them into hist
1267 : : call read_vars_hist(ncid,hist,natom,time,has_nimage,1,start_time,&
1268 : : & xred_id,fcart_id,vel_id,vel_cell_id,rprimd_id,acell_id,&
1269 : 25 : & strten_id,etotal_id,ekin_id,entropy_id,mdtime_id)
1270 : :
1271 : : !Close NetCDF file
1272 : 25 : ncerr = nf90_close(ncid)
1273 [ - + ]: 25 : NCF_CHECK_MSG(ncerr," close netcdf history file")
1274 : :
1275 : : end subroutine read_md_hist
1276 : : !!***
1277 : :
1278 : : !----------------------------------------------------------------------
1279 : :
1280 : : !!****f* m_abihist/read_md_hist_img
1281 : : !!
1282 : : !! NAME
1283 : : !! read_md_hist_img
1284 : : !!
1285 : : !! FUNCTION
1286 : : !! Read the history file from a netcdf file and store it into a hist dataset structure
1287 : : !! This version is compatible with multiple images of the simulation cell.
1288 : : !!
1289 : : !! INPUTS
1290 : : !! filename = Filename of the NetCDF to read
1291 : : !! isVUsed,isARUsed=flags used to initialize hist structure
1292 : : !! [imgtab(:)]= In case of multiple images,indexes of images to be read
1293 : : !! Default is 1,2,3,...
1294 : : !! Size must be equal to size(hist)
1295 : : !!
1296 : : !! OUTPUT
1297 : : !! hist(:)<type abihist>=Historical record of positions, forces, stresses, cell dims and energies,
1298 : : !! Size(hist) is equal to a number of images to be read
1299 : : !!
1300 : : !! SOURCE
1301 : :
1302 [ - + + - : 1 : subroutine read_md_hist_img(filename,hist,isVUsed,isARused,imgtab)
+ - - + ]
1303 : :
1304 : : !Arguments ------------------------------------
1305 : : !scalars
1306 : : logical,intent(in) :: isVUsed,isARused
1307 : : character(len=*),intent(in) :: filename
1308 : : !arrays
1309 : : integer,intent(in),optional :: imgtab(:)
1310 : : type(abihist),intent(inout),target :: hist(:)
1311 : :
1312 : : !Local variables-------------------------------
1313 : : !scalars
1314 : : integer :: iimage,iimg,my_nimage,ncerr,ncid,nimage,natom,time
1315 : : integer :: nimage_id,natom_id,xyz_id,time_id,six_id, ntypat, ntypat_id
1316 : : integer :: xcart_id,xred_id,fcart_id,gred_id,ekin_id,entropy_id
1317 : : integer :: mdtime_id,vel_id,vel_cell_id,etotal_id
1318 : : integer :: acell_id,rprimd_id,strten_id
1319 : : logical :: has_nimage
1320 : : !character(len=500) :: msg
1321 : : type(abihist),pointer :: hist_
1322 : 1 : integer,allocatable :: my_imgtab(:)
1323 : : ! *************************************************************************
1324 : :
1325 [ + + + + ]: 11 : hist%ihist=0 ; hist%mxhist=0
1326 : :
1327 : : !Open netCDF file
1328 : 1 : ncerr=nf90_open(path=trim(filename),mode=NF90_NOWRITE,ncid=ncid)
1329 [ - + ]: 1 : if(ncerr /= NF90_NOERR) then
1330 : 0 : write(std_out,*) 'Could no open ',trim(filename),', starting from scratch'
1331 : 0 : return
1332 : : else
1333 : 1 : write(std_out,*) 'Succesfully open ',trim(filename),' for reading'
1334 : 1 : write(std_out,*) 'Extracting information from NetCDF file...'
1335 : : end if
1336 : :
1337 : : !Manage multiple images of the cell
1338 : 1 : my_nimage=size(hist)
1339 [ + - ]: 1 : if (my_nimage==0) return
1340 [ - + + - : 3 : ABI_MALLOC(my_imgtab,(my_nimage))
+ - + - -
+ - + ]
1341 [ + - ]: 1 : if (present(imgtab)) then
1342 [ - + ]: 1 : if (size(my_imgtab)/=my_nimage) then
1343 : 0 : ABI_BUG('Inconsistency between hist and imgtab!')
1344 : : end if
1345 [ + + ]: 6 : my_imgtab(:)=imgtab(:)
1346 : : else
1347 [ # # # # : 0 : my_imgtab(:)=(/(iimage,iimage=1,my_nimage)/)
# # ]
1348 : : end if
1349 : :
1350 : : !Inquire dimensions IDs and lengths
1351 : : call get_dims_hist(ncid,natom,ntypat,nimage,time,&
1352 : 1 : & natom_id,ntypat_id,nimage_id,time_id,xyz_id,six_id,has_nimage)
1353 : :
1354 [ + + - + ]: 6 : if (nimage<maxval(my_imgtab)) then
1355 : 0 : ABI_ERROR('Not enough images in the HIST file!')
1356 : : end if
1357 : :
1358 : : !Loop over images
1359 [ + + ]: 6 : do iimage=1,my_nimage
1360 : 5 : iimg=my_imgtab(iimage)
1361 : 5 : hist_ => hist(iimage)
1362 : :
1363 : : ! Allocate hist structure
1364 : 5 : call abihist_init(hist_,natom,time,isVused,isARused)
1365 : :
1366 : : ! Get the ID of a variables from their name
1367 : : call get_varid_hist(ncid,xcart_id,xred_id,fcart_id,gred_id,vel_id,vel_cell_id,&
1368 : 5 : & rprimd_id,acell_id,strten_id,etotal_id,ekin_id,entropy_id,mdtime_id,has_nimage)
1369 : :
1370 : : ! Read variables from the dataset and write them into hist
1371 : : call read_vars_hist(ncid,hist_,natom,time,has_nimage,iimg,1,&
1372 : : & xred_id,fcart_id,vel_id,vel_cell_id,rprimd_id,acell_id,&
1373 : 6 : & strten_id,etotal_id,ekin_id,entropy_id,mdtime_id)
1374 : :
1375 : : end do
1376 : :
1377 : : !Close NetCDF file
1378 : 1 : ncerr = nf90_close(ncid)
1379 [ - + ]: 1 : NCF_CHECK_MSG(ncerr," close netcdf history file")
1380 : :
1381 [ - + ]: 1 : ABI_FREE(my_imgtab)
1382 : :
1383 : 1 : end subroutine read_md_hist_img
1384 : : !!***
1385 : :
1386 : : !----------------------------------------------------------------------
1387 : :
1388 : : !!****f* m_abihist/def_file_hist
1389 : : !! NAME
1390 : : !! def_file_hist
1391 : : !!
1392 : : !! FUNCTION
1393 : : !!
1394 : : !! INPUTS
1395 : : !!
1396 : : !! OUTPUT
1397 : : !!
1398 : : !! SOURCE
1399 : :
1400 : 328 : subroutine def_file_hist(ncid,natom,nimage,ntypat,npsp,has_nimage)
1401 : :
1402 : : !Arguments ------------------------------------
1403 : : !scalars
1404 : : integer,intent(in) :: ncid
1405 : : integer,intent(in) :: natom,nimage,ntypat,npsp
1406 : : logical,intent(in) :: has_nimage
1407 : :
1408 : : !Local variables-------------------------------
1409 : : !scalars
1410 : : integer :: ncerr
1411 : : integer :: natom_id,nimage_id,ntypat_id,npsp_id,time_id,xyz_id,six_id
1412 : : integer :: xcart_id,xred_id,fcart_id,gred_id,vel_id,vel_cell_id
1413 : : integer :: rprimd_id,acell_id,strten_id
1414 : : integer :: etotal_id,ekin_id,entropy_id,mdtime_id
1415 : : integer :: typat_id,znucl_id,amu_id,dtion_id,ndof_id,imgmov_id, two_id,mdtemp_id
1416 : : !character(len=500) :: msg
1417 : : !arrays
1418 : : integer :: dim0(0),dim1(1),dim2(2),dim3(3),dim4(4)
1419 : : ! *************************************************************************
1420 : :
1421 : : !1.Define the dimensions
1422 [ - + ]: 328 : if (npsp/=ntypat) then
1423 : 0 : ABI_WARNING('HIST file does not support alchemical mixing!')
1424 : : end if
1425 : :
1426 : 328 : ncerr = nf90_def_dim(ncid,"natom",natom,natom_id)
1427 [ - + ]: 328 : NCF_CHECK_MSG(ncerr," define dimension natom")
1428 : :
1429 : 328 : ncerr = nf90_def_dim(ncid,"ntypat",ntypat,ntypat_id)
1430 [ - + ]: 328 : NCF_CHECK_MSG(ncerr," define dimension ntypat")
1431 : :
1432 [ + + ]: 328 : if (has_nimage) then
1433 : 30 : ncerr = nf90_def_dim(ncid,"nimage",nimage,nimage_id)
1434 [ - + ]: 30 : NCF_CHECK_MSG(ncerr," define dimension nimage")
1435 : : end if
1436 : :
1437 : 328 : ncerr = nf90_def_dim(ncid,"npsp",npsp,npsp_id)
1438 [ - + ]: 328 : NCF_CHECK_MSG(ncerr," define dimension npsp")
1439 : :
1440 : 328 : ncerr = nf90_def_dim(ncid,"xyz",3,xyz_id)
1441 [ - + ]: 328 : NCF_CHECK_MSG(ncerr," define dimension xyz")
1442 : :
1443 : 328 : ncerr = nf90_def_dim(ncid,"six",6,six_id)
1444 [ - + ]: 328 : NCF_CHECK_MSG(ncerr," define dimension six")
1445 : :
1446 : 328 : ncerr = nf90_def_dim(ncid,"time",NF90_UNLIMITED,time_id)
1447 [ - + ]: 328 : NCF_CHECK_MSG(ncerr," define dimension time")
1448 : :
1449 : 328 : ncerr = nf90_def_dim(ncid,"two",2,two_id)
1450 [ - + ]: 328 : NCF_CHECK_MSG(ncerr," define dimension two")
1451 : :
1452 : : !2.Define the constant variables
1453 : :
1454 : : call ab_define_var(ncid,dim0,ndof_id,NF90_INT,&
1455 : 328 : & "ndof","Number of Degrees Of Freedom","dimensionless" )
1456 : :
1457 [ + + ]: 656 : dim1=(/natom_id/)
1458 : : call ab_define_var(ncid,dim1,typat_id,NF90_DOUBLE,&
1459 : 328 : & "typat","types of atoms","dimensionless" )
1460 : :
1461 [ + + ]: 656 : dim1=(/npsp_id/)
1462 : : call ab_define_var(ncid,dim1,znucl_id,NF90_DOUBLE,&
1463 : 328 : & "znucl","atomic charges","atomic units" )
1464 : :
1465 [ + + ]: 656 : dim1=(/ntypat_id/)
1466 : : call ab_define_var(ncid,dim1,amu_id,NF90_DOUBLE,&
1467 : 328 : & "amu","atomic masses","atomic units" )
1468 : :
1469 : : call ab_define_var(ncid,dim0,dtion_id,NF90_DOUBLE,&
1470 : 328 : & "dtion","time step","atomic units" )
1471 : :
1472 : : !mdtemp
1473 [ + + ]: 656 : dim1=(/two_id/)
1474 : : call ab_define_var(ncid,dim1,mdtemp_id,NF90_DOUBLE,&
1475 : 328 : & "mdtemp","Molecular Dynamics Thermostat Temperatures","Kelvin" )
1476 : :
1477 : : !mdtime
1478 [ + + ]: 656 : dim1=(/time_id/)
1479 : : call ab_define_var(ncid,dim1,mdtime_id,NF90_DOUBLE,&
1480 : 328 : & "mdtime","Molecular Dynamics or Relaxation TIME","hbar/Ha" )
1481 : :
1482 : : !3.Define the evolving variables
1483 : :
1484 : : !xcart,xred,fcart,gred,vel
1485 [ + + ]: 328 : if (has_nimage) then
1486 : : call ab_define_var(ncid,dim0,imgmov_id,NF90_INT,&
1487 : 30 : & "imgmov","Image mover","Not relevant" )
1488 [ + + ]: 150 : dim4=(/xyz_id,natom_id,nimage_id,time_id/)
1489 : : call ab_define_var(ncid,dim4,xcart_id,NF90_DOUBLE,&
1490 : 30 : & "xcart","vectors (X) of atom positions in CARTesian coordinates","bohr" )
1491 : : call ab_define_var(ncid,dim4,xred_id,NF90_DOUBLE,&
1492 : 30 : & "xred","vectors (X) of atom positions in REDuced coordinates","dimensionless" )
1493 : : call ab_define_var(ncid,dim4,fcart_id,NF90_DOUBLE,&
1494 : 30 : & "fcart","atom Forces in CARTesian coordinates","Ha/bohr" )
1495 : : call ab_define_var(ncid,dim4,gred_id,NF90_DOUBLE,&
1496 : 30 : & "fred","atom Forces in REDuced coordinates","dimensionless" ) ! XG210315 : should be "Gradients in REDuced ..."
1497 : : call ab_define_var(ncid,dim4,vel_id,NF90_DOUBLE,&
1498 : 30 : & "vel","VELocities of atoms","bohr*Ha/hbar" )
1499 : : else
1500 [ + + ]: 1192 : dim3=(/xyz_id,natom_id,time_id/)
1501 : : call ab_define_var(ncid,dim3,xcart_id,NF90_DOUBLE,&
1502 : 298 : & "xcart","vectors (X) of atom positions in CARTesian coordinates","bohr" )
1503 : : call ab_define_var(ncid,dim3,xred_id,NF90_DOUBLE,&
1504 : 298 : & "xred","vectors (X) of atom positions in REDuced coordinates","dimensionless" )
1505 : : call ab_define_var(ncid,dim3,fcart_id,NF90_DOUBLE,&
1506 : 298 : & "fcart","atom Forces in CARTesian coordinates","Ha/bohr" )
1507 : : call ab_define_var(ncid,dim3,gred_id,NF90_DOUBLE,&
1508 : 298 : & "fred","atom Forces in REDuced coordinates","dimensionless" ) ! XG210315 : should be "Gradients in REDuced ..."
1509 : : call ab_define_var(ncid,dim3,vel_id,NF90_DOUBLE,&
1510 : 298 : & "vel","VELocities of atoms","bohr*Ha/hbar" )
1511 : : end if
1512 : :
1513 : : !rprimd,vel_cell
1514 [ + + ]: 328 : if (has_nimage) then
1515 [ + + ]: 150 : dim4=(/xyz_id,xyz_id,nimage_id,time_id/)
1516 : : call ab_define_var(ncid,dim4,rprimd_id,NF90_DOUBLE,&
1517 : 30 : & "rprimd","Real space PRIMitive translations, Dimensional","bohr" )
1518 : : call ab_define_var(ncid,dim4,vel_cell_id,NF90_DOUBLE,&
1519 : 30 : & "vel_cell","VELocities of CELl","bohr*Ha/hbar" )
1520 : : else
1521 [ + + ]: 1192 : dim3=(/xyz_id,xyz_id,time_id/)
1522 : : call ab_define_var(ncid,dim3,rprimd_id,NF90_DOUBLE,&
1523 : 298 : & "rprimd","Real space PRIMitive translations, Dimensional","bohr" )
1524 : : call ab_define_var(ncid,dim3,vel_cell_id,NF90_DOUBLE,&
1525 : 298 : & "vel_cell","VELocities of cell","bohr*Ha/hbar" )
1526 : : end if
1527 : :
1528 : : !acell
1529 [ + + ]: 328 : if (has_nimage) then
1530 [ + + ]: 120 : dim3=(/xyz_id,nimage_id,time_id/)
1531 : : call ab_define_var(ncid,dim3,acell_id,NF90_DOUBLE,&
1532 : 30 : & "acell","CELL lattice vector scaling","bohr" )
1533 : : else
1534 [ + + ]: 894 : dim2=(/xyz_id,time_id/)
1535 : : call ab_define_var(ncid,dim2,acell_id,NF90_DOUBLE,&
1536 : 298 : & "acell","CELL lattice vector scaling","bohr" )
1537 : : end if
1538 : :
1539 : : !strten
1540 [ + + ]: 328 : if (has_nimage) then
1541 [ + + ]: 120 : dim3=(/six_id,nimage_id,time_id/)
1542 : : call ab_define_var(ncid,dim3,strten_id,NF90_DOUBLE,&
1543 : 30 : & "strten","STRess tensor","Ha/bohr^3" )
1544 : : else
1545 [ + + ]: 894 : dim2=(/six_id,time_id/)
1546 : : call ab_define_var(ncid,dim2,strten_id,NF90_DOUBLE,&
1547 : 298 : & "strten","STRess tensor","Ha/bohr^3" )
1548 : : end if
1549 : :
1550 : : !etotal,ekin,entropy
1551 [ + + ]: 328 : if (has_nimage) then
1552 [ + + ]: 90 : dim2=(/nimage_id,time_id/)
1553 : : call ab_define_var(ncid,dim2,etotal_id,NF90_DOUBLE,&
1554 : 30 : & "etotal","TOTAL Energy","Ha" )
1555 : : call ab_define_var(ncid,dim2,ekin_id,NF90_DOUBLE,&
1556 : 30 : & "ekin","Energy KINetic ionic","Ha" )
1557 : : call ab_define_var(ncid,dim2,entropy_id,NF90_DOUBLE,&
1558 : 30 : & "entropy","Entropy","" )
1559 : : else
1560 [ + + ]: 596 : dim1=(/time_id/)
1561 : : call ab_define_var(ncid,dim1,etotal_id,NF90_DOUBLE,&
1562 : 298 : & "etotal","TOTAL Energy","Ha" )
1563 : : call ab_define_var(ncid,dim1,ekin_id,NF90_DOUBLE,&
1564 : 298 : & "ekin","Energy KINetic ionic","Ha" )
1565 : : call ab_define_var(ncid,dim1,entropy_id,NF90_DOUBLE,&
1566 : 298 : & "entropy","Entropy","" )
1567 : : end if
1568 : :
1569 : : !4.End define mode
1570 : :
1571 : 328 : ncerr = nf90_enddef(ncid)
1572 [ - + ]: 328 : NCF_CHECK_MSG(ncerr," end define mode")
1573 : :
1574 : 328 : end subroutine def_file_hist
1575 : : !!***
1576 : :
1577 : : !----------------------------------------------------------------------
1578 : :
1579 : : !!****f* m_abihist/get_dims_hist
1580 : : !! NAME
1581 : : !! get_dims_hist
1582 : : !!
1583 : : !! FUNCTION
1584 : : !!
1585 : : !! INPUTS
1586 : : !!
1587 : : !! OUTPUT
1588 : : !!
1589 : : !! SOURCE
1590 : :
1591 : 33 : subroutine get_dims_hist(ncid,natom,ntypat,nimage,time,&
1592 : : natom_id,ntypat_id,nimage_id,time_id,xyz_id,six_id,has_nimage)
1593 : :
1594 : : !Arguments ------------------------------------
1595 : : !scalars
1596 : : integer,intent(in) :: ncid
1597 : : integer,intent(out) :: natom,nimage,time,ntypat
1598 : : integer,intent(out) :: natom_id,nimage_id,time_id,xyz_id,six_id, ntypat_id
1599 : : logical,intent(out) :: has_nimage
1600 : :
1601 : : !Local variables-------------------------------
1602 : : integer :: ncerr
1603 : : character(len=5) :: char_tmp
1604 : : ! *************************************************************************
1605 : :
1606 : : !Inquire dimensions IDs
1607 : :
1608 : 33 : ncerr = nf90_inq_dimid(ncid,"natom",natom_id)
1609 [ - + ]: 33 : NCF_CHECK_MSG(ncerr," inquire dimension ID for natom")
1610 : :
1611 : 33 : ncerr = nf90_inq_dimid(ncid,"npsp",ntypat_id)
1612 [ - + ]: 33 : NCF_CHECK_MSG(ncerr," inquire dimension ID for npsp")
1613 : :
1614 : 33 : ncerr = nf90_inq_dimid(ncid,"xyz",xyz_id)
1615 [ - + ]: 33 : NCF_CHECK_MSG(ncerr," inquire dimension ID for xyz")
1616 : :
1617 : 33 : ncerr = nf90_inq_dimid(ncid,"time",time_id)
1618 [ - + ]: 33 : NCF_CHECK_MSG(ncerr," inquire dimension ID for time")
1619 : :
1620 : 33 : ncerr = nf90_inq_dimid(ncid,"six",six_id)
1621 [ - + ]: 33 : NCF_CHECK_MSG(ncerr," inquire dimension ID for six")
1622 : :
1623 : 33 : ncerr = nf90_inq_dimid(ncid,"nimage",nimage_id)
1624 : 33 : has_nimage=(ncerr==nf90_noerr)
1625 : :
1626 : : !Inquire dimensions lengths
1627 : :
1628 [ + + ]: 33 : if (has_nimage) then
1629 : 1 : ncerr = nf90_inquire_dimension(ncid,nimage_id,char_tmp,nimage)
1630 : 1 : has_nimage=(ncerr==nf90_noerr)
1631 : : end if
1632 [ + + ]: 33 : if (.not.has_nimage) nimage=1
1633 : :
1634 : 33 : ncerr = nf90_inquire_dimension(ncid,natom_id,char_tmp,natom)
1635 [ - + ]: 33 : NCF_CHECK_MSG(ncerr," inquire dimension natom")
1636 : :
1637 : 33 : ncerr = nf90_inquire_dimension(ncid,ntypat_id,char_tmp,ntypat)
1638 [ - + ]: 33 : NCF_CHECK_MSG(ncerr," inquire dimension ntypat")
1639 : :
1640 : 33 : ncerr = nf90_inquire_dimension(ncid,time_id,char_tmp,time)
1641 [ - + ]: 33 : NCF_CHECK_MSG(ncerr," inquire dimension time")
1642 : :
1643 : 33 : end subroutine get_dims_hist
1644 : : !!***
1645 : :
1646 : : !----------------------------------------------------------------------
1647 : :
1648 : : !!****f* m_abihist/get_varid_hist
1649 : : !! NAME
1650 : : !! get_varid_hist
1651 : : !!
1652 : : !! FUNCTION
1653 : : !!
1654 : : !! INPUTS
1655 : : !!
1656 : : !! OUTPUT
1657 : : !!
1658 : : !! SOURCE
1659 : :
1660 : 2733 : subroutine get_varid_hist(ncid,xcart_id,xred_id,fcart_id,gred_id,vel_id,vel_cell_id,&
1661 : : & rprimd_id,acell_id,strten_id,etotal_id,ekin_id,entropy_id,mdtime_id,has_nimage)
1662 : :
1663 : : !Arguments ------------------------------------
1664 : : !scalars
1665 : : integer,intent(in) :: ncid
1666 : : integer,intent(out) :: xcart_id,xred_id,fcart_id,gred_id,vel_id
1667 : : integer,intent(out) :: vel_cell_id,rprimd_id,acell_id,strten_id
1668 : : integer,intent(out) :: etotal_id,ekin_id,entropy_id,mdtime_id
1669 : : logical,intent(in) :: has_nimage
1670 : :
1671 : : !Local variables-------------------------------
1672 : : integer :: ncerr
1673 : : ! *************************************************************************
1674 : :
1675 : 2733 : ncerr = nf90_inq_varid(ncid, "mdtime", mdtime_id)
1676 [ - + ]: 2733 : NCF_CHECK_MSG(ncerr," get the id for mdtime")
1677 : :
1678 : 2733 : ncerr = nf90_inq_varid(ncid, "xcart", xcart_id)
1679 [ - + ]: 2733 : NCF_CHECK_MSG(ncerr," get the id for xcart")
1680 : :
1681 : 2733 : ncerr = nf90_inq_varid(ncid, "xred", xred_id)
1682 [ - + ]: 2733 : NCF_CHECK_MSG(ncerr," get the id for xred")
1683 : :
1684 : 2733 : ncerr = nf90_inq_varid(ncid, "fcart", fcart_id)
1685 [ - + ]: 2733 : NCF_CHECK_MSG(ncerr," get the id for fcart")
1686 : :
1687 : 2733 : ncerr = nf90_inq_varid(ncid, "fred", gred_id)
1688 [ - + ]: 2733 : NCF_CHECK_MSG(ncerr," get the id for fred") ! XG210315 : should be "gred"
1689 : :
1690 : 2733 : ncerr = nf90_inq_varid(ncid, "vel", vel_id)
1691 [ - + ]: 2733 : NCF_CHECK_MSG(ncerr," get the id for vel")
1692 : :
1693 : 2733 : ncerr = nf90_inq_varid(ncid, "vel_cell", vel_cell_id)
1694 [ + + ]: 2733 : if(has_nimage) then
1695 [ - + ]: 230 : NCF_CHECK_MSG(ncerr," get the id for vel_cell")
1696 : : end if
1697 : :
1698 : 2733 : ncerr = nf90_inq_varid(ncid, "rprimd", rprimd_id)
1699 [ - + ]: 2733 : NCF_CHECK_MSG(ncerr," get the id for rprimd")
1700 : :
1701 : 2733 : ncerr = nf90_inq_varid(ncid, "acell", acell_id)
1702 [ - + ]: 2733 : NCF_CHECK_MSG(ncerr," get the id for acell")
1703 : :
1704 : 2733 : ncerr = nf90_inq_varid(ncid, "strten", strten_id)
1705 [ - + ]: 2733 : NCF_CHECK_MSG(ncerr," get the id for strten")
1706 : :
1707 : 2733 : ncerr = nf90_inq_varid(ncid, "etotal", etotal_id)
1708 [ - + ]: 2733 : NCF_CHECK_MSG(ncerr," get the id for etotal")
1709 : :
1710 : 2733 : ncerr = nf90_inq_varid(ncid, "ekin", ekin_id)
1711 [ - + ]: 2733 : NCF_CHECK_MSG(ncerr," get the id for ekin")
1712 : :
1713 : 2733 : ncerr = nf90_inq_varid(ncid, "entropy", entropy_id)
1714 [ - + ]: 2733 : NCF_CHECK_MSG(ncerr," get the id for entropy")
1715 : :
1716 : 2733 : end subroutine get_varid_hist
1717 : : !!***
1718 : :
1719 : : !----------------------------------------------------------------------
1720 : :
1721 : : !!****f* m_abihist/read_csts_hist
1722 : : !!
1723 : : !! NAME
1724 : : !! read_csts_hist
1725 : : !!
1726 : : !! FUNCTION
1727 : : !!
1728 : : !! INPUTS
1729 : : !!
1730 : : !! OUTPUT
1731 : : !!
1732 : : !! SOURCE
1733 : :
1734 [ - + - + : 7 : subroutine read_csts_hist(ncid,dtion,typat,znucl,amu)
- + ]
1735 : :
1736 : : !Arguments ------------------------------------
1737 : : !scalars
1738 : : integer,intent(in) :: ncid
1739 : : real(dp),intent(out) :: dtion
1740 : : !arrays
1741 : : integer,intent(out) :: typat(:)
1742 : : real(dp),intent(out) :: amu(:),znucl(:)
1743 : :
1744 : : !Local variables-------------------------------
1745 : : integer :: ncerr, typat_id,znucl_id,amu_id,dtion_id
1746 : : ! *************************************************************************
1747 : :
1748 : : !1.Get the IDs
1749 : 7 : ncerr = nf90_inq_varid(ncid, "typat", typat_id)
1750 [ - + ]: 7 : NCF_CHECK_MSG(ncerr," get the id for typat")
1751 : :
1752 : 7 : ncerr = nf90_inq_varid(ncid, "znucl", znucl_id)
1753 [ - + ]: 7 : NCF_CHECK_MSG(ncerr," get the id for znucl")
1754 : :
1755 : 7 : ncerr = nf90_inq_varid(ncid, "amu", amu_id)
1756 [ - + ]: 7 : NCF_CHECK_MSG(ncerr," get the id for amu")
1757 : :
1758 : 7 : ncerr = nf90_inq_varid(ncid, "dtion", dtion_id)
1759 [ - + ]: 7 : NCF_CHECK_MSG(ncerr," get the id for dtion")
1760 : :
1761 : : !2.Write the constants
1762 : 7 : ncerr = nf90_get_var(ncid, typat_id, typat)
1763 [ - + ]: 7 : NCF_CHECK_MSG(ncerr," get variable typat")
1764 : :
1765 : 7 : ncerr = nf90_get_var(ncid, znucl_id, znucl)
1766 [ - + ]: 7 : NCF_CHECK_MSG(ncerr," get variable znucl")
1767 : :
1768 : 7 : ncerr = nf90_get_var(ncid, amu_id, amu)
1769 [ - + ]: 7 : NCF_CHECK_MSG(ncerr," get variable amu")
1770 : :
1771 : 7 : ncerr = nf90_get_var(ncid, dtion_id, dtion)
1772 [ - + ]: 7 : NCF_CHECK_MSG(ncerr," get variable dtion")
1773 : :
1774 : 7 : end subroutine read_csts_hist
1775 : : !!***
1776 : :
1777 : : !----------------------------------------------------------------------
1778 : :
1779 : : !!****f* m_abihist/write_csts_hist
1780 : : !!
1781 : : !! NAME
1782 : : !! write_csts_hist
1783 : : !!
1784 : : !! FUNCTION
1785 : : !!
1786 : : !! INPUTS
1787 : : !!
1788 : : !! OUTPUT
1789 : : !!
1790 : : !! SOURCE
1791 : :
1792 [ - + - + : 328 : subroutine write_csts_hist(ncid,dtion,imgmov,typat,znucl,amu,mdtemp,ndof)
- + ]
1793 : :
1794 : : !Arguments ------------------------------------
1795 : : !scalars
1796 : : integer,intent(in) :: ncid
1797 : : real(dp),intent(in) :: dtion
1798 : : integer,intent(in) :: imgmov,ndof
1799 : : !arrays
1800 : : integer,intent(in) :: typat(:)
1801 : : real(dp),intent(in) :: amu(:),znucl(:), mdtemp(2)
1802 : :
1803 : : !Local variables-------------------------------
1804 : : !scalars
1805 : : integer :: ncerr
1806 : : integer :: typat_id,znucl_id,amu_id,dtion_id, imgmov_id, mdtemp_id, ndof_id
1807 : : ! *************************************************************************
1808 : :
1809 : : !1.Get the IDs
1810 : :
1811 : 328 : ncerr = nf90_inq_varid(ncid, "typat", typat_id)
1812 [ - + ]: 328 : NCF_CHECK_MSG(ncerr," get the id for typat")
1813 : :
1814 : 328 : ncerr = nf90_inq_varid(ncid, "znucl", znucl_id)
1815 [ - + ]: 328 : NCF_CHECK_MSG(ncerr," get the id for znucl")
1816 : :
1817 : 328 : ncerr = nf90_inq_varid(ncid, "amu", amu_id)
1818 [ - + ]: 328 : NCF_CHECK_MSG(ncerr," get the id for amu")
1819 : :
1820 : 328 : ncerr = nf90_inq_varid(ncid, "dtion", dtion_id)
1821 [ - + ]: 328 : NCF_CHECK_MSG(ncerr," get the id for dtion")
1822 : :
1823 : 328 : ncerr = nf90_inq_varid(ncid, "ndof", ndof_id)
1824 [ - + ]: 328 : NCF_CHECK_MSG(ncerr," get the id for ndof")
1825 : :
1826 [ + + ]: 328 : if ( nf90_noerr == nf90_inq_varid(ncid, "imgmov", imgmov_id) ) then
1827 : 30 : ncerr = nf90_put_var(ncid, imgmov_id, imgmov)
1828 [ - + ]: 30 : NCF_CHECK_MSG(ncerr," write variable imgmov")
1829 : : end if
1830 : :
1831 [ + - ]: 328 : if ( nf90_noerr == nf90_inq_varid(ncid, "mdtemp", mdtemp_id) ) then
1832 : 328 : ncerr = nf90_put_var(ncid, mdtemp_id, mdtemp)
1833 [ - + ]: 328 : NCF_CHECK_MSG(ncerr," write variable mdtemp")
1834 : : end if
1835 : :
1836 : : !2.Write the constants
1837 : :
1838 : 328 : ncerr = nf90_put_var(ncid, typat_id, typat)
1839 [ - + ]: 328 : NCF_CHECK_MSG(ncerr," write variable typat")
1840 : :
1841 : 328 : ncerr = nf90_put_var(ncid, znucl_id, znucl)
1842 [ - + ]: 328 : NCF_CHECK_MSG(ncerr," write variable znucl")
1843 : :
1844 : 328 : ncerr = nf90_put_var(ncid, amu_id, amu)
1845 [ - + ]: 328 : NCF_CHECK_MSG(ncerr," write variable amu")
1846 : :
1847 : 328 : ncerr = nf90_put_var(ncid, ndof_id, ndof)
1848 [ - + ]: 328 : NCF_CHECK_MSG(ncerr," write variable ndof")
1849 : :
1850 : 328 : ncerr = nf90_put_var(ncid, dtion_id, dtion)
1851 [ - + ]: 328 : NCF_CHECK_MSG(ncerr," write variable dtion")
1852 : :
1853 : 328 : end subroutine write_csts_hist
1854 : : !!***
1855 : :
1856 : : !----------------------------------------------------------------------
1857 : :
1858 : : !!****f* m_abihist/write_vars_hist
1859 : : !!
1860 : : !! NAME
1861 : : !! write_vars_hist
1862 : : !!
1863 : : !! FUNCTION
1864 : : !!
1865 : : !! INPUTS
1866 : : !!
1867 : : !! OUTPUT
1868 : : !!
1869 : : !! SOURCE
1870 : :
1871 : 3832 : subroutine write_vars_hist(ncid,hist,natom,has_nimage,iimg,itime,&
1872 : : & xcart_id,xred_id,fcart_id,gred_id,vel_id,vel_cell_id,rprimd_id,&
1873 : : & acell_id,strten_id,etotal_id,ekin_id,entropy_id,mdtime_id)
1874 : :
1875 : : !Arguments ------------------------------------
1876 : : !scalars
1877 : : integer,intent(in) :: ncid,natom,iimg,itime
1878 : : integer,intent(in) :: xcart_id,xred_id,fcart_id,gred_id,vel_id
1879 : : integer,intent(in) :: vel_cell_id,rprimd_id,acell_id,strten_id
1880 : : integer,intent(in) :: etotal_id,ekin_id,entropy_id,mdtime_id
1881 : : logical,intent(in) :: has_nimage
1882 : : type(abihist),intent(inout),target :: hist
1883 : :
1884 : : !Local variables-------------------------------
1885 : : !scalars
1886 : : integer :: ncerr
1887 : : !arrays
1888 : : integer :: count2(2),count3(3),count4(4)
1889 : : integer :: start1(1),start2(2),start3(3),start4(4)
1890 : 3832 : real(dp),allocatable :: conv(:,:)
1891 : 3832 : real(dp),pointer :: xred(:,:),fcart(:,:),rprimd(:,:),vel(:,:),vel_cell(:,:)
1892 : : ! *************************************************************************
1893 : :
1894 : 3832 : xred => hist%xred(:,:,hist%ihist)
1895 : 3832 : fcart => hist%fcart(:,:,hist%ihist)
1896 : 3832 : vel => hist%vel(:,:,hist%ihist)
1897 : 3832 : vel_cell => hist%vel_cell(:,:,hist%ihist)
1898 : 3832 : rprimd => hist%rprimd(:,:,hist%ihist)
1899 : :
1900 : : !Variables not depending on images
1901 : :
1902 : : !mdtime
1903 [ + + ]: 7664 : start1=(/itime/)
1904 : 3832 : ncerr = nf90_put_var(ncid,mdtime_id,hist%time(hist%ihist),start=start1)
1905 [ - + ]: 3832 : NCF_CHECK_MSG(ncerr," write variable mdtime")
1906 : :
1907 : : !Variables depending on images
1908 : :
1909 [ - + + - : 11496 : ABI_MALLOC(conv,(3,natom))
+ - + - -
+ - + ]
1910 : :
1911 : : !xcart,xred,fcart,gred,vel
1912 [ + + ]: 3832 : if (has_nimage) then
1913 [ + + + + ]: 12186 : start4=(/1,1,iimg,itime/);count4=(/3,natom,1,1/)
1914 [ - + - + ]: 1354 : call xred2xcart(natom,rprimd,conv,xred)
1915 : 1354 : ncerr = nf90_put_var(ncid,xcart_id,conv, start = start4,count = count4)
1916 [ - + ]: 1354 : NCF_CHECK_MSG(ncerr," write variable xcart")
1917 : 1354 : ncerr = nf90_put_var(ncid,xred_id,xred, start = start4,count = count4)
1918 [ - + ]: 1354 : NCF_CHECK_MSG(ncerr," write variable xred")
1919 : 1354 : ncerr = nf90_put_var(ncid,fcart_id,fcart,start = start4,count = count4)
1920 [ - + ]: 1354 : NCF_CHECK_MSG(ncerr," write variable fcart")
1921 [ - + - + ]: 1354 : call fcart2gred(fcart,conv,rprimd,natom)
1922 : 1354 : ncerr = nf90_put_var(ncid,gred_id,conv, start = start4,count = count4)
1923 [ - + ]: 1354 : NCF_CHECK_MSG(ncerr," write variable fred") ! XG210315 : should be "gred"
1924 : 1354 : ncerr = nf90_put_var(ncid,vel_id,vel, start = start4,count = count4)
1925 [ - + ]: 1354 : NCF_CHECK_MSG(ncerr," write variable vel")
1926 : : else
1927 [ + + + + ]: 17346 : start3=(/1,1,itime/);count3=(/3,natom,1/)
1928 [ - + - + ]: 2478 : call xred2xcart(natom,rprimd,conv,xred)
1929 : 2478 : ncerr = nf90_put_var(ncid,xcart_id,conv, start = start3,count = count3)
1930 [ - + ]: 2478 : NCF_CHECK_MSG(ncerr," write variable xcart")
1931 : 2478 : ncerr = nf90_put_var(ncid,xred_id,xred, start = start3,count = count3)
1932 [ - + ]: 2478 : NCF_CHECK_MSG(ncerr," write variable xred")
1933 : 2478 : ncerr = nf90_put_var(ncid,fcart_id,fcart,start = start3,count = count3)
1934 [ - + ]: 2478 : NCF_CHECK_MSG(ncerr," write variable fcart")
1935 [ - + - + ]: 2478 : call fcart2gred(fcart,conv,rprimd,natom)
1936 : 2478 : ncerr = nf90_put_var(ncid,gred_id,conv, start = start3,count = count3)
1937 [ - + ]: 2478 : NCF_CHECK_MSG(ncerr," write variable fred") ! XG210315 : should be "gred"
1938 : 2478 : ncerr = nf90_put_var(ncid,vel_id,vel, start = start3,count = count3)
1939 [ - + ]: 2478 : NCF_CHECK_MSG(ncerr," write variable vel")
1940 : : end if
1941 : :
1942 [ - + ]: 3832 : ABI_FREE(conv)
1943 : :
1944 : : !rprimd,vel_cell
1945 [ + + ]: 3832 : if (has_nimage) then
1946 [ + + ]: 6770 : start4=(/1,1,iimg,itime/);count4=(/3,3,1,1/)
1947 : : ncerr = nf90_put_var(ncid,rprimd_id,hist%rprimd(:,:,hist%ihist),&
1948 : 1354 : & start = start4,count = count4)
1949 [ - + ]: 1354 : NCF_CHECK_MSG(ncerr," write variable rprimd")
1950 : : ncerr = nf90_put_var(ncid,vel_cell_id,hist%vel_cell(:,:,hist%ihist),&
1951 : 1354 : & start = start4,count = count4)
1952 [ - + ]: 1354 : NCF_CHECK_MSG(ncerr," write variable vel_cell")
1953 : : else
1954 [ + + ]: 9912 : start3=(/1,1,itime/);count3=(/3,3,1/)
1955 : : ncerr = nf90_put_var(ncid,rprimd_id,hist%rprimd(:,:,hist%ihist),&
1956 : 2478 : & start = start3,count = count3)
1957 [ - + ]: 2478 : NCF_CHECK_MSG(ncerr," write variable rprimd")
1958 : : ncerr = nf90_put_var(ncid,vel_cell_id,hist%vel_cell(:,:,hist%ihist),&
1959 : 2478 : & start = start3,count = count3)
1960 [ - + ]: 2478 : NCF_CHECK_MSG(ncerr," write variable vel_cell")
1961 : : end if
1962 : :
1963 : : !acell
1964 [ + + ]: 3832 : if (has_nimage) then
1965 [ + + ]: 5416 : start3=(/1,iimg,itime/);count3=(/3,1,1/)
1966 : : ncerr = nf90_put_var(ncid,acell_id,hist%acell(:,hist%ihist),&
1967 : 1354 : & start = start3,count = count3)
1968 [ - + ]: 1354 : NCF_CHECK_MSG(ncerr," write variable acell")
1969 : : else
1970 [ + + ]: 7434 : start2=(/1,itime/);count2=(/3,1/)
1971 : : ncerr = nf90_put_var(ncid,acell_id,hist%acell(:,hist%ihist),&
1972 : 2478 : & start = start2,count = count2)
1973 [ - + ]: 2478 : NCF_CHECK_MSG(ncerr," write variable acell")
1974 : : end if
1975 : :
1976 : : !strten
1977 [ + + ]: 3832 : if (has_nimage) then
1978 [ + + ]: 5416 : start3=(/1,iimg,itime/);count3=(/6,1,1/)
1979 : : ncerr = nf90_put_var(ncid,strten_id,hist%strten(:,hist%ihist),&
1980 : 1354 : & start = start3,count = count3)
1981 [ - + ]: 1354 : NCF_CHECK_MSG(ncerr," write variable strten")
1982 : : else
1983 [ + + ]: 7434 : start2=(/1,itime/);count2=(/6,1/)
1984 : : ncerr = nf90_put_var(ncid,strten_id,hist%strten(:,hist%ihist),&
1985 : 2478 : & start = start2,count = count2)
1986 [ - + ]: 2478 : NCF_CHECK_MSG(ncerr," write variable strten")
1987 : : end if
1988 : :
1989 : : !etotal,ekin,entropy
1990 [ + + ]: 3832 : if (has_nimage) then
1991 [ + + ]: 4062 : start2=(/iimg,itime/)
1992 : 1354 : ncerr = nf90_put_var(ncid,etotal_id,hist%etot(hist%ihist),start=start2)
1993 [ - + ]: 1354 : NCF_CHECK_MSG(ncerr," write variable etotal")
1994 : 1354 : ncerr = nf90_put_var(ncid,ekin_id,hist%ekin(hist%ihist),start=start2)
1995 [ - + ]: 1354 : NCF_CHECK_MSG(ncerr," write variable ekin")
1996 : 1354 : ncerr = nf90_put_var(ncid,entropy_id,hist%entropy(hist%ihist),start=start2)
1997 [ - + ]: 1354 : NCF_CHECK_MSG(ncerr," write variable entropy")
1998 : : else
1999 [ + + ]: 4956 : start1=(/itime/)
2000 : 2478 : ncerr = nf90_put_var(ncid,etotal_id,hist%etot(hist%ihist),start=start1)
2001 [ - + ]: 2478 : NCF_CHECK_MSG(ncerr," write variable etotal")
2002 : 2478 : ncerr = nf90_put_var(ncid,ekin_id,hist%ekin(hist%ihist),start=start1)
2003 [ - + ]: 2478 : NCF_CHECK_MSG(ncerr," write variable ekin")
2004 : 2478 : ncerr = nf90_put_var(ncid,entropy_id,hist%entropy(hist%ihist),start=start1)
2005 [ - + ]: 2478 : NCF_CHECK_MSG(ncerr," write variable entropy")
2006 : : end if
2007 : :
2008 : 3832 : end subroutine write_vars_hist
2009 : : !!***
2010 : :
2011 : : !----------------------------------------------------------------------
2012 : :
2013 : : !!****f* m_abihist/read_vars_hist
2014 : : !!
2015 : : !! NAME
2016 : : !! read_vars_hist
2017 : : !!
2018 : : !! FUNCTION
2019 : : !!
2020 : : !! INPUTS
2021 : : !!
2022 : : !! OUTPUT
2023 : : !!
2024 : : !! SOURCE
2025 : :
2026 : 30 : subroutine read_vars_hist(ncid,hist,natom,time,has_nimage,iimg,start_time,&
2027 : : & xred_id,fcart_id,vel_id,vel_cell_id,rprimd_id,acell_id,&
2028 : : & strten_id,etotal_id,ekin_id,entropy_id,mdtime_id)
2029 : :
2030 : : !Arguments ------------------------------------
2031 : : !scalars
2032 : : integer,intent(in) :: ncid,natom,time,iimg
2033 : : integer,intent(in) :: xred_id,fcart_id,vel_id,vel_cell_id,rprimd_id
2034 : : integer,intent(in) :: acell_id,strten_id
2035 : : integer,intent(in) :: etotal_id,ekin_id,entropy_id,mdtime_id
2036 : : integer,intent(in) :: start_time
2037 : : logical,intent(in) :: has_nimage
2038 : : type(abihist),intent(inout),target :: hist
2039 : :
2040 : : !Local variables-------------------------------
2041 : : !scalars
2042 : : integer :: ncerr
2043 : : !arrays
2044 : : integer :: count1(1),count2(2),count3(3),count4(4)
2045 : : integer :: start1(1),start2(2),start3(3),start4(4)
2046 : : ! *************************************************************************
2047 : :
2048 : : !Variables not depending on imes
2049 : :
2050 : : !mdtime
2051 [ + + + + ]: 90 : start1=(/start_time/);count1=(/time/)
2052 : 30 : ncerr = nf90_get_var(ncid,mdtime_id,hist%time(:),count=count1,start=start1)
2053 [ - + ]: 30 : NCF_CHECK_MSG(ncerr," read variable mdtime")
2054 : :
2055 : : !Variables depending on images
2056 : :
2057 : : !xred,fcart,vel
2058 [ + + ]: 30 : if (has_nimage) then
2059 [ + + + + ]: 45 : start4=(/1,1,iimg,start_time/);count4=(/3,natom,1,time/)
2060 : 5 : ncerr = nf90_get_var(ncid,xred_id ,hist%xred(:,:,:),count=count4,start=start4)
2061 [ - + ]: 5 : NCF_CHECK_MSG(ncerr," read variable xred")
2062 : 5 : ncerr = nf90_get_var(ncid,fcart_id ,hist%fcart(:,:,:),count=count4,start=start4)
2063 [ - + ]: 5 : NCF_CHECK_MSG(ncerr," read variable fcart")
2064 : 5 : ncerr = nf90_get_var(ncid,vel_id,hist%vel(:,:,:),count=count4,start=start4)
2065 [ - + ]: 5 : NCF_CHECK_MSG(ncerr," read variable vel")
2066 : : else
2067 [ + + + + ]: 175 : start3=(/1,1,start_time/);count3=(/3,natom,time/)
2068 : 25 : ncerr = nf90_get_var(ncid,xred_id ,hist%xred(:,:,:),count=count3,start=start3)
2069 [ - + ]: 25 : NCF_CHECK_MSG(ncerr," read variable xred")
2070 : 25 : ncerr = nf90_get_var(ncid,fcart_id ,hist%fcart(:,:,:),count=count3,start=start3)
2071 [ - + ]: 25 : NCF_CHECK_MSG(ncerr," read variable fcart")
2072 : 25 : ncerr = nf90_get_var(ncid,vel_id,hist%vel(:,:,:),count=count3,start=start3)
2073 [ - + ]: 25 : NCF_CHECK_MSG(ncerr," read variable vel")
2074 : : end if
2075 : :
2076 : : !rprimd,vel_cell
2077 [ + + ]: 30 : if (has_nimage) then
2078 [ + + + + ]: 45 : start4=(/1,1,iimg,start_time/);count4=(/3,3,start_time,time/)
2079 : 5 : ncerr = nf90_get_var(ncid,rprimd_id,hist%rprimd(:,:,:),count=count4,start=start4)
2080 [ - + ]: 5 : NCF_CHECK_MSG(ncerr," read variable rprimd")
2081 : 5 : ncerr = nf90_get_var(ncid,vel_cell_id,hist%vel_cell(:,:,:),count=count4,start=start4)
2082 [ - + ]: 5 : NCF_CHECK_MSG(ncerr," read variable vel_cell")
2083 : : else
2084 [ + + + + ]: 175 : start3=(/1,1,start_time/);count3=(/3,3,time/)
2085 : 25 : ncerr = nf90_get_var(ncid,rprimd_id,hist%rprimd(:,:,:),count=count3,start=start3)
2086 [ - + ]: 25 : NCF_CHECK_MSG(ncerr," read variable rprimd")
2087 : : end if
2088 : :
2089 : : !acell
2090 [ + + ]: 30 : if (has_nimage) then
2091 [ + + + + ]: 35 : start3=(/1,iimg,start_time/);count3=(/3,1,time/)
2092 : 5 : ncerr = nf90_get_var(ncid,acell_id,hist%acell(:,:),count=count3,start=start3)
2093 [ - + ]: 5 : NCF_CHECK_MSG(ncerr," read variable acell")
2094 : : else
2095 [ + + + + ]: 125 : start2=(/1,start_time/);count2=(/3,time/)
2096 : 25 : ncerr = nf90_get_var(ncid,acell_id,hist%acell(:,:),count=count2,start=start2)
2097 [ - + ]: 25 : NCF_CHECK_MSG(ncerr," read variable acell")
2098 : : end if
2099 : :
2100 : : !strten
2101 [ + + ]: 30 : if (has_nimage) then
2102 [ + + + + ]: 35 : start3=(/1,iimg,start_time/);count3=(/6,1,time/)
2103 : 5 : ncerr = nf90_get_var(ncid, strten_id,hist%strten(:,:),count=count3,start=start3)
2104 [ - + ]: 5 : NCF_CHECK_MSG(ncerr," read variable strten")
2105 : : else
2106 [ + + + + ]: 125 : start2=(/1,start_time/);count2=(/6,time/)
2107 : 25 : ncerr = nf90_get_var(ncid, strten_id,hist%strten(:,:),count=count2,start=start2)
2108 [ - + ]: 25 : NCF_CHECK_MSG(ncerr," read variable strten")
2109 : : end if
2110 : :
2111 : : !etotal,ekin,entropy
2112 [ + + ]: 30 : if (has_nimage) then
2113 [ + + + + ]: 25 : start2=(/1,start_time/);count2=(/1,time/)
2114 : 5 : ncerr = nf90_get_var(ncid,etotal_id,hist%etot(:),count=count2,start=start2)
2115 [ - + ]: 5 : NCF_CHECK_MSG(ncerr," read variable etotal")
2116 : 5 : ncerr = nf90_get_var(ncid,ekin_id ,hist%ekin(:),count=count2,start=start2)
2117 [ - + ]: 5 : NCF_CHECK_MSG(ncerr," read variable ekin")
2118 : 5 : ncerr = nf90_get_var(ncid,entropy_id,hist%entropy(:),count=count2,start=start2)
2119 [ - + ]: 5 : NCF_CHECK_MSG(ncerr," read variable entropy")
2120 : : else
2121 [ + + + + ]: 75 : start1=(/start_time/);count1=(/time/)
2122 : 25 : ncerr = nf90_get_var(ncid,etotal_id,hist%etot(:),count=count1,start=start1)
2123 [ - + ]: 25 : NCF_CHECK_MSG(ncerr," read variable etotal")
2124 : 25 : ncerr = nf90_get_var(ncid,ekin_id,hist%ekin(:),count=count1,start=start1)
2125 [ - + ]: 25 : NCF_CHECK_MSG(ncerr," read variable ekin")
2126 : 25 : ncerr = nf90_get_var(ncid,entropy_id,hist%entropy(:),count=count1,start=start1)
2127 [ - + ]: 25 : NCF_CHECK_MSG(ncerr," read variable entropy")
2128 : : end if
2129 : :
2130 : 30 : end subroutine read_vars_hist
2131 : : !!***
2132 : :
2133 [ # # # # : 0 : end module m_abihist
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # #
# ]
|
