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 4726 : 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 4726 : hist%ihist=1
195 4726 : hist%mxhist=mxhist
196 4726 : hist%ndof=3*natom
197 :
198 : !Initialize flags
199 4726 : hist%isVused=isVUsed
200 4726 : hist%isARused=isARUsed
201 :
202 : !Allocate all the histories
203 14178 : ABI_MALLOC(hist%acell,(3,mxhist))
204 14178 : ABI_MALLOC(hist%rprimd,(3,3,mxhist))
205 :
206 18904 : ABI_MALLOC(hist%xred,(3,natom,mxhist))
207 14178 : ABI_MALLOC(hist%fcart,(3,natom,mxhist))
208 14178 : ABI_MALLOC(hist%strten,(6,mxhist))
209 14178 : ABI_MALLOC(hist%vel,(3,natom,mxhist))
210 9452 : ABI_MALLOC(hist%vel_cell,(3,3,mxhist))
211 14178 : ABI_MALLOC(hist%etot,(mxhist))
212 9452 : ABI_MALLOC(hist%ekin,(mxhist))
213 9452 : ABI_MALLOC(hist%entropy,(mxhist))
214 9452 : ABI_MALLOC(hist%time,(mxhist))
215 :
216 4726 : hist%etot(1)=zero
217 4726 : hist%ekin(1)=zero
218 4726 : hist%entropy(1)=zero
219 4726 : hist%time(1)=zero
220 :
221 18904 : hist%acell(:,1)=zero
222 61438 : hist%rprimd(:,:,1)=zero
223 84034 : hist%xred(:,:,1)=zero
224 84034 : hist%fcart(:,:,1)=zero
225 33082 : hist%strten(:,1)=zero
226 84034 : hist%vel(:,:,1)=zero
227 140433 : hist%vel_cell(:,:,:)=zero
228 :
229 4726 : 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 5292 : subroutine abihist_free_0D(hist)
281 :
282 : !Arguments ------------------------------------
283 : class(abihist),intent(inout) :: hist
284 : ! ***************************************************************
285 :
286 5292 : ABI_SFREE(hist%acell)
287 5292 : ABI_SFREE(hist%rprimd)
288 5292 : ABI_SFREE(hist%xred)
289 5292 : ABI_SFREE(hist%fcart)
290 5292 : ABI_SFREE(hist%strten)
291 5292 : ABI_SFREE(hist%vel)
292 5292 : ABI_SFREE(hist%vel_cell)
293 5292 : ABI_SFREE(hist%etot)
294 5292 : ABI_SFREE(hist%ekin)
295 5292 : ABI_SFREE(hist%entropy)
296 5292 : ABI_SFREE(hist%time)
297 :
298 5292 : 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 83 : 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 35 : hist%ihist=0 ; hist%mxhist=0
1236 :
1237 : !Open netCDF file
1238 35 : ncerr=nf90_open(path=trim(filename),mode=NF90_NOWRITE,ncid=ncid)
1239 35 : if(ncerr /= NF90_NOERR) then
1240 11 : write(std_out,*) 'Could no open ',trim(filename),', starting from scratch'
1241 11 : return
1242 : else
1243 24 : write(std_out,*) 'Succesfully open ',trim(filename),' for reading'
1244 24 : 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 24 : & 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 24 : if(readOnlyLast)then
1253 4 : start_time = time
1254 4 : time = 1
1255 : else
1256 20 : start_time = 1
1257 : end if
1258 :
1259 : !Allocate hist structure
1260 24 : 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 24 : & 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 24 : & strten_id,etotal_id,ekin_id,entropy_id,mdtime_id)
1270 :
1271 : !Close NetCDF file
1272 24 : ncerr = nf90_close(ncid)
1273 24 : 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 31 : 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 31 : ncerr = nf90_inq_dimid(ncid,"natom",natom_id)
1609 31 : NCF_CHECK_MSG(ncerr," inquire dimension ID for natom")
1610 :
1611 31 : ncerr = nf90_inq_dimid(ncid,"npsp",ntypat_id)
1612 31 : NCF_CHECK_MSG(ncerr," inquire dimension ID for npsp")
1613 :
1614 31 : ncerr = nf90_inq_dimid(ncid,"xyz",xyz_id)
1615 31 : NCF_CHECK_MSG(ncerr," inquire dimension ID for xyz")
1616 :
1617 31 : ncerr = nf90_inq_dimid(ncid,"time",time_id)
1618 31 : NCF_CHECK_MSG(ncerr," inquire dimension ID for time")
1619 :
1620 31 : ncerr = nf90_inq_dimid(ncid,"six",six_id)
1621 31 : NCF_CHECK_MSG(ncerr," inquire dimension ID for six")
1622 :
1623 31 : ncerr = nf90_inq_dimid(ncid,"nimage",nimage_id)
1624 31 : has_nimage=(ncerr==nf90_noerr)
1625 :
1626 : !Inquire dimensions lengths
1627 :
1628 31 : 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 31 : if (.not.has_nimage) nimage=1
1633 :
1634 31 : ncerr = nf90_inquire_dimension(ncid,natom_id,char_tmp,natom)
1635 31 : NCF_CHECK_MSG(ncerr," inquire dimension natom")
1636 :
1637 31 : ncerr = nf90_inquire_dimension(ncid,ntypat_id,char_tmp,ntypat)
1638 31 : NCF_CHECK_MSG(ncerr," inquire dimension ntypat")
1639 :
1640 31 : ncerr = nf90_inquire_dimension(ncid,time_id,char_tmp,time)
1641 31 : NCF_CHECK_MSG(ncerr," inquire dimension time")
1642 :
1643 31 : 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 2732 : 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 2732 : ncerr = nf90_inq_varid(ncid, "mdtime", mdtime_id)
1676 2732 : NCF_CHECK_MSG(ncerr," get the id for mdtime")
1677 :
1678 2732 : ncerr = nf90_inq_varid(ncid, "xcart", xcart_id)
1679 2732 : NCF_CHECK_MSG(ncerr," get the id for xcart")
1680 :
1681 2732 : ncerr = nf90_inq_varid(ncid, "xred", xred_id)
1682 2732 : NCF_CHECK_MSG(ncerr," get the id for xred")
1683 :
1684 2732 : ncerr = nf90_inq_varid(ncid, "fcart", fcart_id)
1685 2732 : NCF_CHECK_MSG(ncerr," get the id for fcart")
1686 :
1687 2732 : ncerr = nf90_inq_varid(ncid, "fred", gred_id)
1688 2732 : NCF_CHECK_MSG(ncerr," get the id for fred") ! XG210315 : should be "gred"
1689 :
1690 2732 : ncerr = nf90_inq_varid(ncid, "vel", vel_id)
1691 2732 : NCF_CHECK_MSG(ncerr," get the id for vel")
1692 :
1693 2732 : ncerr = nf90_inq_varid(ncid, "vel_cell", vel_cell_id)
1694 2732 : if(has_nimage) then
1695 230 : NCF_CHECK_MSG(ncerr," get the id for vel_cell")
1696 : end if
1697 :
1698 2732 : ncerr = nf90_inq_varid(ncid, "rprimd", rprimd_id)
1699 2732 : NCF_CHECK_MSG(ncerr," get the id for rprimd")
1700 :
1701 2732 : ncerr = nf90_inq_varid(ncid, "acell", acell_id)
1702 2732 : NCF_CHECK_MSG(ncerr," get the id for acell")
1703 :
1704 2732 : ncerr = nf90_inq_varid(ncid, "strten", strten_id)
1705 2732 : NCF_CHECK_MSG(ncerr," get the id for strten")
1706 :
1707 2732 : ncerr = nf90_inq_varid(ncid, "etotal", etotal_id)
1708 2732 : NCF_CHECK_MSG(ncerr," get the id for etotal")
1709 :
1710 2732 : ncerr = nf90_inq_varid(ncid, "ekin", ekin_id)
1711 2732 : NCF_CHECK_MSG(ncerr," get the id for ekin")
1712 :
1713 2732 : ncerr = nf90_inq_varid(ncid, "entropy", entropy_id)
1714 2732 : NCF_CHECK_MSG(ncerr," get the id for entropy")
1715 :
1716 2732 : 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 6 : 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 6 : ncerr = nf90_inq_varid(ncid, "typat", typat_id)
1750 6 : NCF_CHECK_MSG(ncerr," get the id for typat")
1751 :
1752 6 : ncerr = nf90_inq_varid(ncid, "znucl", znucl_id)
1753 6 : NCF_CHECK_MSG(ncerr," get the id for znucl")
1754 :
1755 6 : ncerr = nf90_inq_varid(ncid, "amu", amu_id)
1756 6 : NCF_CHECK_MSG(ncerr," get the id for amu")
1757 :
1758 6 : ncerr = nf90_inq_varid(ncid, "dtion", dtion_id)
1759 6 : NCF_CHECK_MSG(ncerr," get the id for dtion")
1760 :
1761 : !2.Write the constants
1762 6 : ncerr = nf90_get_var(ncid, typat_id, typat)
1763 6 : NCF_CHECK_MSG(ncerr," get variable typat")
1764 :
1765 6 : ncerr = nf90_get_var(ncid, znucl_id, znucl)
1766 6 : NCF_CHECK_MSG(ncerr," get variable znucl")
1767 :
1768 6 : ncerr = nf90_get_var(ncid, amu_id, amu)
1769 6 : NCF_CHECK_MSG(ncerr," get variable amu")
1770 :
1771 6 : ncerr = nf90_get_var(ncid, dtion_id, dtion)
1772 6 : NCF_CHECK_MSG(ncerr," get variable dtion")
1773 :
1774 6 : 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 29 : 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 87 : start1=(/start_time/);count1=(/time/)
2052 29 : ncerr = nf90_get_var(ncid,mdtime_id,hist%time(:),count=count1,start=start1)
2053 29 : NCF_CHECK_MSG(ncerr," read variable mdtime")
2054 :
2055 : !Variables depending on images
2056 :
2057 : !xred,fcart,vel
2058 29 : 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 168 : start3=(/1,1,start_time/);count3=(/3,natom,time/)
2068 24 : ncerr = nf90_get_var(ncid,xred_id ,hist%xred(:,:,:),count=count3,start=start3)
2069 24 : NCF_CHECK_MSG(ncerr," read variable xred")
2070 24 : ncerr = nf90_get_var(ncid,fcart_id ,hist%fcart(:,:,:),count=count3,start=start3)
2071 24 : NCF_CHECK_MSG(ncerr," read variable fcart")
2072 24 : ncerr = nf90_get_var(ncid,vel_id,hist%vel(:,:,:),count=count3,start=start3)
2073 24 : NCF_CHECK_MSG(ncerr," read variable vel")
2074 : end if
2075 :
2076 : !rprimd,vel_cell
2077 29 : 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 168 : start3=(/1,1,start_time/);count3=(/3,3,time/)
2085 24 : ncerr = nf90_get_var(ncid,rprimd_id,hist%rprimd(:,:,:),count=count3,start=start3)
2086 24 : NCF_CHECK_MSG(ncerr," read variable rprimd")
2087 : end if
2088 :
2089 : !acell
2090 29 : 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 120 : start2=(/1,start_time/);count2=(/3,time/)
2096 24 : ncerr = nf90_get_var(ncid,acell_id,hist%acell(:,:),count=count2,start=start2)
2097 24 : NCF_CHECK_MSG(ncerr," read variable acell")
2098 : end if
2099 :
2100 : !strten
2101 29 : 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 120 : start2=(/1,start_time/);count2=(/6,time/)
2107 24 : ncerr = nf90_get_var(ncid, strten_id,hist%strten(:,:),count=count2,start=start2)
2108 24 : NCF_CHECK_MSG(ncerr," read variable strten")
2109 : end if
2110 :
2111 : !etotal,ekin,entropy
2112 29 : 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 72 : start1=(/start_time/);count1=(/time/)
2122 24 : ncerr = nf90_get_var(ncid,etotal_id,hist%etot(:),count=count1,start=start1)
2123 24 : NCF_CHECK_MSG(ncerr," read variable etotal")
2124 24 : ncerr = nf90_get_var(ncid,ekin_id,hist%ekin(:),count=count1,start=start1)
2125 24 : NCF_CHECK_MSG(ncerr," read variable ekin")
2126 24 : ncerr = nf90_get_var(ncid,entropy_id,hist%entropy(:),count=count1,start=start1)
2127 24 : NCF_CHECK_MSG(ncerr," read variable entropy")
2128 : end if
2129 :
2130 29 : end subroutine read_vars_hist
2131 : !!***
2132 :
2133 0 : end module m_abihist
|
