Branch data Line data Source code
1 : : !!****m* ABINIT/m_results_out
2 : : !! NAME
3 : : !! m_results_out
4 : : !!
5 : : !! FUNCTION
6 : : !! This module provides the definition of the results_out_type used
7 : : !! to store results from GS calculations.
8 : : !!
9 : : !! COPYRIGHT
10 : : !! Copyright (C) 2008-2026 ABINIT group (MT)
11 : : !! This file is distributed under the terms of the
12 : : !! GNU General Public License, see ~abinit/COPYING
13 : : !! or http://www.gnu.org/copyleft/gpl.txt .
14 : : !!
15 : : !! TODO
16 : : !! One should replace the 'pointer' by 'allocatable'. This was tried, in October 2014,
17 : : !! but Petrus_nag complained (test v67mbpt t31...t34), and also max2 (paral#08 np=10).
18 : : !!
19 : : !! SOURCE
20 : :
21 : : #if defined HAVE_CONFIG_H
22 : : #include "config.h"
23 : : #endif
24 : :
25 : : #include "abi_common.h"
26 : :
27 : : MODULE m_results_out
28 : :
29 : : use defs_basis
30 : : use m_dtset
31 : : use m_errors
32 : : use m_abicore
33 : : use m_xmpi
34 : :
35 : : use defs_abitypes, only : MPI_type
36 : :
37 : : implicit none
38 : :
39 : : private
40 : :
41 : : ! public procedures.
42 : : public :: init_results_out
43 : : public :: destroy_results_out
44 : : public :: copy_results_out
45 : : public :: gather_results_out
46 : : !!***
47 : :
48 : : !!****t* m_results_out/results_out_type
49 : : !! NAME
50 : : !! results_out_type
51 : : !!
52 : : !! FUNCTION
53 : : !! This structured datatype contains a subset of the results of a GS
54 : : !! calculation, needed to perform the so-called "internal tests", and
55 : : !! to perform the timing analysis
56 : : !!
57 : : !! SOURCE
58 : :
59 : : type, public :: results_out_type
60 : :
61 : : ! WARNING : if you modify this datatype, please check whether there might be creation/destruction/copy routines,
62 : : ! declared in another part of ABINIT, that might need to take into account your modification.
63 : :
64 : : ! Integer scalar
65 : :
66 : : integer :: natom
67 : : ! The number of atoms for this dataset
68 : : integer :: nimage
69 : : ! The number of images of the cell for this dataset (treated by current proc)
70 : : integer :: nkpt
71 : : ! The number of k-pints for this dataset
72 : : integer :: nocc
73 : : ! The number of occupations for this dataset
74 : : integer :: npsp
75 : : ! The number of pseudopotentials
76 : : integer :: ntypat
77 : : ! The number of types of atoms
78 : :
79 : : ! Integer arrays
80 : :
81 : : integer, pointer :: npwtot(:,:)
82 : : ! npw(mxnkpt,nimage) Full number of plane waves for each
83 : : ! k point, computed with the "true" rprimd
84 : : ! Not taking into account the decrease due to istwfk
85 : : ! Not taking into account the spread of pws on different procs
86 : :
87 : : ! Real (real(dp)) arrays
88 : :
89 : : real(dp), pointer :: acell(:,:)
90 : : ! acell(3,nimage)
91 : : ! Length of primitive vectors
92 : :
93 : : real(dp), pointer :: amu(:,:)
94 : : ! amu(ntypat,nimage)
95 : : ! Mass of the atomic type
96 : :
97 : : real(dp), pointer :: etotal(:)
98 : : ! etotal(nimage)
99 : : ! Total energy (Hartree)
100 : :
101 : : real(dp), pointer :: fcart(:,:,:)
102 : : ! fcart(3,natom,nimage) Cartesian forces (Hartree/Bohr)
103 : : ! Forces in cartesian coordinates (Hartree)
104 : :
105 : : real(dp), pointer :: gred(:,:,:)
106 : : ! gred(3,natom,nimage)
107 : : ! Forces in reduced coordinates (Hartree)
108 : : ! Actually, gradient of the total energy with respect
109 : : ! to change of reduced coordinates
110 : :
111 : : real(dp), pointer :: intgres(:,:,:)
112 : : ! intgres(4,natom,nimage) ! 4 is for nspden
113 : : ! Gradient of the total energy wrt constraints (Hartree)
114 : :
115 : : real(dp), pointer :: mixalch(:,:,:)
116 : : ! mixalch(npsp,ntypat,nimage) [note that in psps datastructure, the dimensioning is npspalch,ntypalch]
117 : : ! Mixing coefficients going from the input pseudopotentials (those for alchemical mixing) to the alchemical atoms
118 : :
119 : : real(dp), pointer :: occ(:,:)
120 : : ! occ(mxmband_upper*mxnkpt*mxnsppol,nimage)
121 : : ! Electronic occupations
122 : :
123 : : real(dp), pointer :: rprim(:,:,:)
124 : : ! rprim(3,3,nimage)
125 : : ! Dimensionless real space primitive translations
126 : :
127 : : real(dp), pointer :: strten(:,:)
128 : : ! strten(6,nimage)
129 : : ! Stress tensor
130 : :
131 : : real(dp), pointer :: vel(:,:,:)
132 : : ! vel(3,natom,nimage)
133 : : ! Atomic velocities
134 : :
135 : : real(dp), pointer :: vel_cell(:,:,:)
136 : : ! vel_cell(3,3,nimage)
137 : : ! Cell velocities
138 : : ! Time derivatives of dimensional primitive translations
139 : :
140 : : real(dp), pointer :: xred(:,:,:)
141 : : ! xred(3,natom,nimage)
142 : : ! Atomic positions in reduced coordinates
143 : :
144 : : end type results_out_type
145 : : !!***
146 : :
147 : : CONTAINS
148 : :
149 : : !===========================================================
150 : : !!***
151 : :
152 : : !!****f* m_results_out/init_results_out
153 : : !! NAME
154 : : !! init_results_out
155 : : !!
156 : : !! FUNCTION
157 : : !! Init all scalars and pointers in an array of results_out datastructures
158 : : !!
159 : : !! INPUTS
160 : : !! dtsets(:)= <type datafiles_type> contains all input variables,
161 : : !! option_alloc=0: only allocate datastructure
162 : : !! 1: allocate and initialize the whole datastructure
163 : : !! 2: allocate datastructure and initialize only first member
164 : : !! option_size=0: allocate results_out with a global number images
165 : : !! (use mxnimage=max(dtset%nimage))
166 : : !! 1: allocate results_out with a number of images per processor
167 : : !! (use mxnimage=max(mpi_enreg%my_nimage))
168 : : !! mpi_enregs=information about MPI parallelization
169 : : !! mxnimage=-optional- maximal value of nimage over datasets
170 : : !! if this argument is present, it is used for allocations
171 : : !! if it is not present, allocations are automatic
172 : : !! natom= number of atoms
173 : : !! nband= number of bands
174 : : !! nkpt= number of k-points
175 : : !! nsppol= number of independant spin components
176 : : !!
177 : : !! SIDE EFFECTS
178 : : !! results_out(:)=<type(results_out_type)>=results_out datastructure array
179 : : !!
180 : : !! SOURCE
181 : :
182 [ - + ]: 1440 : subroutine init_results_out(dtsets,option_alloc,option_size,mpi_enregs,&
183 [ - + - + ]: 1440 : & mxnatom,mxnband,mxnkpt,mxnpsp,mxnsppol,mxntypat,results_out)
184 : :
185 : : !Arguments ------------------------------------
186 : : !scalars
187 : : integer,intent(in) :: option_alloc,option_size
188 : : integer,intent(in) :: mxnatom,mxnband,mxnkpt,mxnpsp,mxnsppol,mxntypat
189 : : !arrays
190 : : type(dataset_type),intent(in) :: dtsets(:)
191 : : type(results_out_type),intent(inout) :: results_out(:)
192 : : type(MPI_type), intent(in) :: mpi_enregs(:)
193 : : !Local variables-------------------------------
194 : : !scalars
195 : : integer :: dtsets_size,idt1,idt2,idt3,ii,jj,kk
196 : : integer :: mpi_enregs_size,mxnimage_,natom_,nkpt_,nocc_
197 : : integer :: results_out_size
198 : : ! type(MPI_type) :: mpi_img
199 : : !arrays
200 : 1440 : integer,allocatable :: img(:,:),nimage(:)
201 : 1440 : real(dp),allocatable :: tmp(:,:)
202 : :
203 : : !************************************************************************
204 : :
205 : : !@results_out_type
206 : :
207 : 1440 : dtsets_size=size(dtsets)
208 : 1440 : results_out_size=size(results_out)
209 : 1440 : mpi_enregs_size=size(mpi_enregs)
210 [ - + ]: 1440 : if (dtsets_size/=mpi_enregs_size .or. dtsets_size/=results_out_size) then
211 : 0 : ABI_ERROR("init_results_out: wrong sizes (2)!")
212 : : endif
213 : :
214 [ + - ]: 1440 : if (results_out_size>0) then
215 : :
216 [ + - ]: 1440 : idt1=lbound(results_out,1);idt2=ubound(results_out,1)
217 [ - + ]: 1440 : idt3=idt2;if (option_alloc==2) idt3=idt1
218 [ - + + - : 4320 : ABI_MALLOC(nimage,(idt1:idt2))
+ - + - -
+ + - ]
219 [ + + ]: 9887 : nimage=0
220 : 1440 : mxnimage_=1
221 [ + - ]: 1440 : if (option_size==0) then
222 [ # # ]: 0 : do ii=idt1,idt2
223 : 0 : nimage(ii)=dtsets(ii)%nimage
224 : 0 : if (nimage(ii)>mxnimage_) mxnimage_=nimage(ii)
225 : : end do
226 [ # # ]: 0 : if (option_alloc>0) then
227 [ # # # # : 0 : ABI_MALLOC(img,(mxnimage_,idt1:idt3))
# # # # #
# # # # #
# # ]
228 [ # # # # ]: 0 : img=0
229 [ # # ]: 0 : do ii=idt1,idt3
230 [ # # ]: 0 : do jj=1,nimage(ii)
231 : 0 : img(jj,ii)=jj
232 : : end do
233 : : end do
234 : : end if
235 : : else
236 [ + + ]: 9887 : do ii=idt1,idt2
237 : 8447 : nimage(ii)=mpi_enregs(ii)%my_nimage
238 : 9887 : if (nimage(ii)>mxnimage_) mxnimage_=nimage(ii)
239 : : end do
240 [ + - ]: 1440 : if (option_alloc>0) then
241 [ - + + - : 5760 : ABI_MALLOC(img,(mxnimage_,idt1:idt3))
- + + - +
- + - - +
- + ]
242 [ + + + + ]: 18735 : img=0
243 [ + + ]: 9887 : do ii=idt1,idt3
244 [ + + ]: 18594 : do jj=1,nimage(ii)
245 : 17154 : img(jj,ii)=mpi_enregs(ii)%my_imgtab(jj)
246 : : end do
247 : : end do
248 : : end if
249 : : end if
250 : :
251 [ + + ]: 9887 : do ii=idt1,idt2
252 : :
253 [ - + + - : 25341 : ABI_MALLOC(results_out(ii)%acell,(3,mxnimage_))
+ - + - -
+ - + ]
254 [ - + + - : 33788 : ABI_MALLOC(results_out(ii)%amu,(mxntypat,mxnimage_))
- + + - +
- + - - +
- + ]
255 [ - + + - : 25341 : ABI_MALLOC(results_out(ii)%etotal,(mxnimage_))
+ - + - -
+ - + ]
256 [ - + + - : 33788 : ABI_MALLOC(results_out(ii)%fcart,(3,mxnatom,mxnimage_))
- + + - +
- + - - +
- + ]
257 [ - + + - : 25341 : ABI_MALLOC(results_out(ii)%gred,(3,mxnatom,mxnimage_))
- + + - -
+ - + ]
258 [ - + + - : 33788 : ABI_MALLOC(results_out(ii)%intgres,(4,mxnatom,mxnimage_))
- + + - +
- + - - +
- + ]
259 [ - + + - : 42235 : ABI_MALLOC(results_out(ii)%mixalch,(mxnpsp,mxntypat,mxnimage_))
- + + - -
+ + - + -
+ - - + -
+ ]
260 [ - + + - : 33788 : ABI_MALLOC(results_out(ii)%npwtot,(mxnkpt,mxnimage_))
- + + - +
- + - - +
- + ]
261 [ - + + - : 33788 : ABI_MALLOC(results_out(ii)%occ,(mxnband*mxnkpt*mxnsppol,mxnimage_))
- + + - +
- + - - +
- + ]
262 [ - + + - : 25341 : ABI_MALLOC(results_out(ii)%rprim,(3,3,mxnimage_))
+ - + - -
+ - + ]
263 [ - + + - : 25341 : ABI_MALLOC(results_out(ii)%strten,(6,mxnimage_))
+ - + - -
+ - + ]
264 [ - + + - : 25341 : ABI_MALLOC(results_out(ii)%vel,(3,mxnatom,mxnimage_))
- + + - -
+ - + ]
265 [ - + + - : 16894 : ABI_MALLOC(results_out(ii)%vel_cell,(3,3,mxnimage_))
- + - + ]
266 [ - + + - : 25341 : ABI_MALLOC(results_out(ii)%xred,(3,mxnatom,mxnimage_))
- + + - -
+ - + ]
267 : :
268 [ - + - - : 9887 : if ((option_alloc==1).or.(option_alloc==2.and.ii==idt3)) then
- - ]
269 : 8447 : results_out(ii)%nimage=nimage(ii)
270 : : results_out(ii)%natom =mxnatom
271 : : results_out(ii)%nkpt =mxnkpt
272 : 8447 : results_out(ii)%npsp =mxnpsp
273 : 8447 : results_out(ii)%ntypat =mxntypat
274 : : results_out(ii)%nocc =mxnband*mxnkpt*mxnsppol
275 : 8447 : natom_=dtsets(ii)%natom
276 : 8447 : nkpt_=dtsets(ii)%nkpt;if(ii==0) nkpt_=mxnkpt
277 : 8447 : nocc_=mxnband*dtsets(ii)%nkpt*dtsets(ii)%nsppol
278 : : results_out(ii)%nimage=nimage(ii)
279 : 8447 : results_out(ii)%natom=natom_
280 : 8447 : results_out(ii)%nkpt=nkpt_
281 : 8447 : results_out(ii)%nocc=nocc_
282 [ + + + + ]: 43839 : results_out(ii)%acell=zero
283 [ + + + + ]: 28638 : results_out(ii)%amu=zero
284 [ + + ]: 17295 : results_out(ii)%etotal(:)=zero
285 [ + + + + : 261303 : results_out(ii)%fcart(:,:,:)=zero
+ + ]
286 [ + + + + : 261303 : results_out(ii)%gred(:,:,:)=zero
+ + ]
287 [ + + + + : 322305 : results_out(ii)%intgres(:,:,:)=zero
+ + ]
288 [ + + + + : 45450 : results_out(ii)%mixalch(:,:,:)=zero
+ + ]
289 [ + + + + ]: 1825661 : results_out(ii)%occ=zero
290 [ + + + + : 123471 : results_out(ii)%rprim=zero
+ + ]
291 [ + + + + ]: 70383 : results_out(ii)%strten(:,:)=zero
292 [ + + + + : 261303 : results_out(ii)%vel=zero
+ + ]
293 [ + + + + : 123471 : results_out(ii)%vel_cell=zero
+ + ]
294 [ + + + + : 261303 : results_out(ii)%xred=zero
+ + ]
295 [ + + + + ]: 234119 : results_out(ii)%npwtot(:,:)=0
296 [ + - ]: 8447 : if (nimage(ii)>0) then
297 [ + + ]: 17154 : do jj=1,nimage(ii)
298 : 8707 : kk=img(jj,ii)
299 [ + + ]: 34828 : results_out(ii)%acell(:,jj) =dtsets(ii)%acell_orig(:,kk)
300 [ + + ]: 19789 : results_out(ii)%amu(:,jj) =dtsets(ii)%amu_orig(:,kk)
301 [ + + + + ]: 113191 : results_out(ii)%rprim(:,:,jj) =dtsets(ii)%rprim_orig(:,:,kk)
302 [ + + + + ]: 113191 : results_out(ii)%vel_cell(:,:,jj)=dtsets(ii)%vel_cell_orig(:,:,kk)
303 [ + + + + ]: 36072 : results_out(ii)%mixalch(:,:,jj) =dtsets(ii)%mixalch_orig(:,:,kk)
304 [ + + ]: 8707 : if (natom_>0) then
305 [ - + + - : 21801 : ABI_MALLOC(tmp,(3,natom_))
+ - - + -
+ ]
306 [ + + + + ]: 162123 : tmp(1:3,1:natom_)=dtsets(ii)%vel_orig(1:3,1:natom_,kk)
307 [ + + + + ]: 162123 : results_out(ii)%vel(1:3,1:natom_,jj)=tmp(1:3,1:natom_)
308 [ + + + + ]: 162123 : tmp(1:3,1:natom_)=dtsets(ii)%xred_orig(1:3,1:natom_,kk)
309 [ + + + + ]: 162123 : results_out(ii)%xred(1:3,1:natom_,jj)=tmp(1:3,1:natom_)
310 [ - + ]: 7267 : ABI_FREE(tmp)
311 : : end if
312 [ + + ]: 17154 : if (nocc_>0) then
313 [ + + ]: 1036713 : results_out(ii)%occ(1:nocc_,jj)=dtsets(ii)%occ_orig(1:nocc_,kk)
314 : : end if
315 : : end do
316 : : end if
317 : : end if
318 : :
319 : : end do
320 [ - + ]: 1440 : ABI_FREE(nimage)
321 : : !if (option_size/=0.and.option_alloc==1) then
322 [ + - ]: 1440 : if (allocated(img)) then
323 : 1440 : ABI_FREE(img)
324 : : end if
325 : : end if
326 : :
327 : 1440 : end subroutine init_results_out
328 : : !!***
329 : :
330 : : !----------------------------------------------------------------------
331 : :
332 : : !!****f* m_results_out/destroy_results_out
333 : : !! NAME
334 : : !! destroy_results_out
335 : : !!
336 : : !! FUNCTION
337 : : !! Clean and destroy an array of results_out datastructures
338 : : !!
339 : : !! SIDE EFFECTS
340 : : !! results_out(:)=<type(results_out_type)>=results_out datastructure array
341 : : !!
342 : : !! SOURCE
343 : :
344 [ - + ]: 1439 : subroutine destroy_results_out(results_out)
345 : :
346 : : !Arguments ------------------------------------
347 : : !arrays
348 : : type(results_out_type),intent(inout) :: results_out(:)
349 : : !Local variables-------------------------------
350 : : !scalars
351 : : integer :: idt1,idt2,ii,results_out_size
352 : :
353 : : !************************************************************************
354 : :
355 : : !@results_out_type
356 : :
357 : 1439 : results_out_size=size(results_out)
358 [ + - ]: 1439 : if (results_out_size>0) then
359 : :
360 [ + - ]: 1439 : idt1=lbound(results_out,1);idt2=ubound(results_out,1)
361 [ + + ]: 9881 : do ii=idt1,idt2
362 : 8442 : results_out(ii)%nimage=0
363 : 8442 : results_out(ii)%natom=0
364 : 8442 : results_out(ii)%nkpt=0
365 : 8442 : results_out(ii)%nocc=0
366 [ + - ]: 8442 : if (associated(results_out(ii)%acell)) then
367 : 8442 : ABI_FREE(results_out(ii)%acell)
368 : : end if
369 [ + - ]: 8442 : if (associated(results_out(ii)%amu)) then
370 : 8442 : ABI_FREE(results_out(ii)%amu)
371 : : end if
372 [ + - ]: 8442 : if (associated(results_out(ii)%etotal)) then
373 : 8442 : ABI_FREE(results_out(ii)%etotal)
374 : : end if
375 [ + - ]: 8442 : if (associated(results_out(ii)%fcart)) then
376 : 8442 : ABI_FREE(results_out(ii)%fcart)
377 : : end if
378 [ + - ]: 8442 : if (associated(results_out(ii)%gred)) then
379 : 8442 : ABI_FREE(results_out(ii)%gred)
380 : : end if
381 [ + - ]: 8442 : if (associated(results_out(ii)%intgres)) then
382 : 8442 : ABI_FREE(results_out(ii)%intgres)
383 : : end if
384 [ + - ]: 8442 : if (associated(results_out(ii)%mixalch)) then
385 : 8442 : ABI_FREE(results_out(ii)%mixalch)
386 : : end if
387 [ + - ]: 8442 : if (associated(results_out(ii)%npwtot)) then
388 : 8442 : ABI_FREE(results_out(ii)%npwtot)
389 : : end if
390 [ + - ]: 8442 : if (associated(results_out(ii)%occ)) then
391 : 8442 : ABI_FREE(results_out(ii)%occ)
392 : : end if
393 [ + - ]: 8442 : if (associated(results_out(ii)%rprim)) then
394 : 8442 : ABI_FREE(results_out(ii)%rprim)
395 : : end if
396 [ + - ]: 8442 : if (associated(results_out(ii)%strten)) then
397 : 8442 : ABI_FREE(results_out(ii)%strten)
398 : : end if
399 [ + - ]: 8442 : if (associated(results_out(ii)%vel)) then
400 : 8442 : ABI_FREE(results_out(ii)%vel)
401 : : end if
402 [ + - ]: 8442 : if (associated(results_out(ii)%vel_cell)) then
403 : 8442 : ABI_FREE(results_out(ii)%vel_cell)
404 : : end if
405 [ + - ]: 9881 : if (associated(results_out(ii)%xred)) then
406 : 8442 : ABI_FREE(results_out(ii)%xred)
407 : : end if
408 : : end do
409 : :
410 : : end if
411 : :
412 : 1439 : end subroutine destroy_results_out
413 : : !!***
414 : :
415 : : !----------------------------------------------------------------------
416 : :
417 : : !!****f* m_results_out/copy_results_out
418 : : !! NAME
419 : : !! copy_results_out
420 : : !!
421 : : !! FUNCTION
422 : : !! Copy a results_out datastructure into another
423 : : !!
424 : : !! INPUTS
425 : : !! results_out_in=<type(results_out_type)>=input results_out datastructure
426 : : !!
427 : : !! OUTPUT
428 : : !! results_out_out=<type(results_out_type)>=output results_out datastructure
429 : : !!
430 : : !! SOURCE
431 : :
432 : 0 : subroutine copy_results_out(results_out_in,results_out_out)
433 : :
434 : : !Arguments ------------------------------------
435 : : !arrays
436 : : type(results_out_type),intent(in) :: results_out_in
437 : : type(results_out_type),intent(out) :: results_out_out
438 : : !Local variables-------------------------------
439 : : !scalars
440 : : integer :: natom_,natom_out,nimage_,nimage_out,nkpt_,nkpt_out,npsp_,npsp_out,nocc_,nocc_out,ntypat_,ntypat_out
441 : :
442 : : !************************************************************************
443 : :
444 : : !@results_out_type
445 : :
446 : 0 : nimage_=size(results_out_in%etotal)
447 : 0 : natom_ =size(results_out_in%fcart,2)
448 : 0 : nkpt_ =size(results_out_in%npwtot,1)
449 : 0 : nocc_ =size(results_out_in%occ,1)
450 : 0 : npsp_ =size(results_out_in%mixalch,1)
451 : 0 : ntypat_=size(results_out_in%mixalch,2)
452 [ # # ]: 0 : nimage_out=0;if (associated(results_out_out%etotal))nimage_out=size(results_out_out%etotal)
453 [ # # ]: 0 : natom_out =0;if (associated(results_out_out%fcart)) natom_out =size(results_out_out%fcart,2)
454 [ # # ]: 0 : nkpt_out =0;if (associated(results_out_out%npwtot))nkpt_out =size(results_out_out%npwtot,1)
455 [ # # ]: 0 : nocc_out =0;if (associated(results_out_out%occ)) nocc_out =size(results_out_out%occ,1)
456 [ # # ]: 0 : npsp_out =0;if (associated(results_out_out%mixalch))npsp_out =size(results_out_out%mixalch,1)
457 [ # # ]: 0 : ntypat_out=0;if (associated(results_out_out%mixalch))ntypat_out=size(results_out_out%mixalch,2)
458 : :
459 [ # # ]: 0 : if (nimage_>nimage_out) then
460 [ # # ]: 0 : if (associated(results_out_out%acell)) then
461 : 0 : ABI_FREE(results_out_out%acell)
462 : : end if
463 [ # # ]: 0 : if (associated(results_out_out%etotal)) then
464 : 0 : ABI_FREE(results_out_out%etotal)
465 : : end if
466 [ # # ]: 0 : if (associated(results_out_out%rprim)) then
467 : 0 : ABI_FREE(results_out_out%rprim)
468 : : end if
469 [ # # ]: 0 : if (associated(results_out_out%strten)) then
470 : 0 : ABI_FREE(results_out_out%strten)
471 : : end if
472 [ # # ]: 0 : if (associated(results_out_out%vel_cell)) then
473 : 0 : ABI_FREE(results_out_out%vel_cell)
474 : : end if
475 [ # # # # : 0 : ABI_MALLOC(results_out_out%acell,(3,nimage_))
# # # # #
# # # ]
476 [ # # # # : 0 : ABI_MALLOC(results_out_out%etotal,(nimage_))
# # # # #
# # # ]
477 [ # # # # : 0 : ABI_MALLOC(results_out_out%rprim,(3,3,nimage_))
# # # # #
# # # ]
478 [ # # # # : 0 : ABI_MALLOC(results_out_out%strten,(6,nimage_))
# # # # #
# # # ]
479 [ # # # # : 0 : ABI_MALLOC(results_out_out%vel_cell,(3,3,nimage_))
# # # # ]
480 : : end if
481 [ # # ]: 0 : if (nimage_>nimage_out.or.natom_>natom_out) then
482 [ # # ]: 0 : if (associated(results_out_out%fcart)) then
483 : 0 : ABI_FREE(results_out_out%fcart)
484 : : end if
485 [ # # ]: 0 : if (associated(results_out_out%gred)) then
486 : 0 : ABI_FREE(results_out_out%gred)
487 : : end if
488 [ # # ]: 0 : if (associated(results_out_out%intgres)) then
489 : 0 : ABI_FREE(results_out_out%intgres)
490 : : end if
491 [ # # ]: 0 : if (associated(results_out_out%vel)) then
492 : 0 : ABI_FREE(results_out_out%vel)
493 : : end if
494 [ # # ]: 0 : if (associated(results_out_out%xred)) then
495 : 0 : ABI_FREE(results_out_out%xred)
496 : : end if
497 [ # # # # : 0 : ABI_MALLOC(results_out_out%fcart,(3,natom_,nimage_))
# # # # #
# # # # #
# # ]
498 [ # # # # : 0 : ABI_MALLOC(results_out_out%gred,(3,natom_,nimage_))
# # # # #
# # # ]
499 [ # # # # : 0 : ABI_MALLOC(results_out_out%intgres,(4,natom_,nimage_))
# # # # #
# # # # #
# # ]
500 [ # # # # : 0 : ABI_MALLOC(results_out_out%vel,(3,natom_,nimage_))
# # # # #
# # # ]
501 [ # # # # : 0 : ABI_MALLOC(results_out_out%xred,(3,natom_,nimage_))
# # # # #
# # # ]
502 : : end if
503 [ # # ]: 0 : if (nimage_>nimage_out.or.nkpt_>nkpt_out) then
504 [ # # ]: 0 : if (associated(results_out_out%npwtot)) then
505 : 0 : ABI_FREE(results_out_out%npwtot)
506 : : end if
507 [ # # # # : 0 : ABI_MALLOC(results_out_out%npwtot,(nkpt_,nimage_))
# # # # #
# # # # #
# # ]
508 : : end if
509 [ # # ]: 0 : if (nimage_>nimage_out.or.nocc_>nocc_out) then
510 [ # # ]: 0 : if (associated(results_out_out%occ)) then
511 : 0 : ABI_FREE(results_out_out%occ)
512 : : end if
513 [ # # # # : 0 : ABI_MALLOC(results_out_out%occ,(nocc_,nimage_))
# # # # #
# # # # #
# # ]
514 : : end if
515 [ # # ]: 0 : if (ntypat_>ntypat_out) then
516 [ # # ]: 0 : if (associated(results_out_out%amu)) then
517 : 0 : ABI_FREE(results_out_out%amu)
518 : : end if
519 [ # # # # : 0 : ABI_MALLOC(results_out_out%amu,(ntypat_,nimage_))
# # # # #
# # # # #
# # ]
520 : : end if
521 : :
522 [ # # ]: 0 : if (npsp_>npsp_out.or.ntypat_>ntypat_out) then
523 [ # # ]: 0 : if (associated(results_out_out%mixalch)) then
524 : 0 : ABI_FREE(results_out_out%mixalch)
525 : : end if
526 [ # # # # : 0 : ABI_MALLOC(results_out_out%mixalch,(npsp_,ntypat_,nimage_))
# # # # #
# # # # #
# # # # #
# ]
527 : : end if
528 : :
529 : 0 : results_out_out%nimage=results_out_in%nimage
530 : 0 : results_out_out%natom =results_out_in%natom
531 : 0 : results_out_out%nkpt =results_out_in%nkpt
532 : 0 : results_out_out%nocc =results_out_in%nocc
533 [ # # # # ]: 0 : results_out_out%acell(1:3,1:nimage_) =results_out_in%acell(1:3,1:nimage_)
534 [ # # # # ]: 0 : results_out_out%amu(1:ntypat_,1:nimage_) =results_out_in%amu(1:ntypat_,1:nimage_)
535 [ # # ]: 0 : results_out_out%etotal(1:nimage_) =results_out_in%etotal(1:nimage_)
536 [ # # # # : 0 : results_out_out%fcart(1:3,1:natom_,1:nimage_)=results_out_in%fcart(1:3,1:natom_,1:nimage_)
# # ]
537 [ # # # # : 0 : results_out_out%gred(1:3,1:natom_,1:nimage_) =results_out_in%gred(1:3,1:natom_,1:nimage_)
# # ]
538 [ # # # # : 0 : results_out_out%intgres(1:4,1:natom_,1:nimage_) =results_out_in%intgres(1:4,1:natom_,1:nimage_)
# # ]
539 [ # # # # : 0 : results_out_out%mixalch(1:npsp_,1:ntypat_,1:nimage_)=results_out_in%mixalch(1:npsp_,1:ntypat_,1:nimage_)
# # ]
540 [ # # # # ]: 0 : results_out_out%npwtot(1:nkpt_,1:nimage_) =results_out_in%npwtot(1:nkpt_,1:nimage_)
541 [ # # # # ]: 0 : results_out_out%occ(1:nocc_,1:nimage_) =results_out_in%occ(1:nocc_,1:nimage_)
542 [ # # # # : 0 : results_out_out%rprim(1:3,1:3,1:nimage_) =results_out_in%rprim(1:3,1:3,1:nimage_)
# # ]
543 [ # # # # ]: 0 : results_out_out%strten(1:6,1:nimage_) =results_out_in%strten(1:6,1:nimage_)
544 [ # # # # : 0 : results_out_out%xred(1:3,1:natom_,1:nimage_) =results_out_in%xred(1:3,1:natom_,1:nimage_)
# # ]
545 [ # # # # : 0 : results_out_out%vel(1:3,1:natom_,1:nimage_) =results_out_in%vel(1:3,1:natom_,1:nimage_)
# # ]
546 [ # # # # : 0 : results_out_out%vel_cell(1:3,1:3,1:nimage_) =results_out_in%vel_cell(1:3,1:3,1:nimage_)
# # ]
547 : :
548 : 0 : end subroutine copy_results_out
549 : : !!***
550 : :
551 : : !----------------------------------------------------------------------
552 : :
553 : : !!****f* m_results_out/gather_results_out
554 : : !! NAME
555 : : !! gather_results_out
556 : : !!
557 : : !! FUNCTION
558 : : !! Gather results_out datastructure array using communicator over images (replicas) of the cell.
559 : : !! Each contribution of single processor is gathered into a big array on master processor
560 : : !!
561 : : !! INPUTS
562 : : !! allgather= --optional, default=false-- if TRUE do ALL_GATHER instead of GATHER
563 : : !! dtsets(:)= <type datafiles_type> contains all input variables,
564 : : !! master= --optional, default=0-- index of master proc receiving gathered data (if allgather=false)
565 : : !! mpi_enregs=information about MPI parallelization
566 : : !! only_one_per_img= --optional, default=true-- if TRUE, the gather operation
567 : : !! is only done by one proc per image (master of the comm_cell)
568 : : !! results_out(:)=<type(results_out_type)>=results_out datastructure array on each proc
569 : : !! use_results_all=true if results_out_all datastructure is allocated for current proc
570 : : !!
571 : : !! SIDE EFFECTS
572 : : !! === f use_results_all=true ===
573 : : !! results_out_all(:)=<type(results_out_type)>=global (gathered) results_out datastructure array
574 : : !!
575 : : !! SOURCE
576 : :
577 [ # # # # : 0 : subroutine gather_results_out(dtsets,mpi_enregs,results_out,results_out_all,use_results_all,&
# # # # ]
578 : : & master,allgather,only_one_per_img) ! optional arguments
579 : :
580 : : !Arguments ------------------------------------
581 : : !scalars
582 : : integer,optional,intent(in) :: master
583 : : logical,optional,intent(in) :: allgather,only_one_per_img
584 : : logical,intent(in) :: use_results_all
585 : : !arrays
586 : : type(dataset_type),intent(in) :: dtsets(:)
587 : : type(results_out_type),intent(in) :: results_out(:)
588 : : type(results_out_type),intent(inout) :: results_out_all(:)
589 : : type(MPI_type), intent(inout) :: mpi_enregs(:)
590 : : !Local variables-------------------------------
591 : : !scalars
592 : : integer :: dtsets_size
593 : : integer :: ibufi,ibufr
594 : : integer :: idt1,idt2,ierr,ii,iproc,jj
595 : : integer :: isize,isize_img
596 : : integer :: master_all,master_img,master_one_img
597 : : integer :: mpi_enregs_size,mxnatom,mxnband,mxnkpt,mxnpsp,mxnsppol,mxntypat
598 : : integer :: natom_,nkpt_,nocc_,npsp_,ntypat_,nimage,nimagetot
599 : : integer :: results_out_size,results_out_all_size
600 : : integer :: rsize,rsize_img
601 : : logical :: do_allgather,one_per_img
602 : : character(len=500) :: msg
603 : : ! type(MPI_type):: mpi_img
604 : : !arrays
605 : 0 : integer,allocatable :: ibuffer(:),ibuffer_all(:),ibufshft(:)
606 : 0 : integer,allocatable :: iimg(:),isize_img_all(:),nimage_all(:)
607 : 0 : integer,allocatable :: rbufshft(:),rsize_img_all(:)
608 : 0 : real(dp),allocatable :: rbuffer(:),rbuffer_all(:)
609 : :
610 : : !************************************************************************
611 : :
612 : : !@results_out_type
613 : :
614 [ # # ]: 0 : one_per_img=.true.;if (present(only_one_per_img)) one_per_img=only_one_per_img
615 [ # # ]: 0 : do_allgather=.false.;if (present(allgather)) do_allgather=allgather
616 : 0 : master_all=0;if (present(master)) master_all=master
617 : :
618 : : ! call init_mpi_enreg(mpi_img,init_mpi=.false.)
619 : 0 : master_img=0;master_one_img=0
620 : : ! i_am_master=(mpi_img%me==master_all)
621 : : ! use_results_all= &
622 : : !& ((( do_allgather).and.( one_per_img).and.(mpi_img%me_cell==master_one_img)) .or. &
623 : : !& (( do_allgather).and.(.not.one_per_img)) .or. &
624 : : !& ((.not.do_allgather).and.( one_per_img).and.(mpi_img%me==master_all)) .or. &
625 : : !& ((.not.do_allgather).and.(.not.one_per_img).and.(mpi_img%me_img==master_img)))
626 : :
627 : 0 : dtsets_size=size(dtsets);results_out_size=size(results_out)
628 : 0 : mpi_enregs_size=size(mpi_enregs)
629 [ # # ]: 0 : if (dtsets_size/=results_out_size) then
630 : 0 : msg=' Wrong sizes for dtsets and results_out datastructures !'
631 : 0 : ABI_BUG(msg)
632 : : end if
633 [ # # ]: 0 : if (mpi_enregs_size/=results_out_size) then
634 : 0 : msg=' Wrong sizes for dtsets and results_out datastructures !'
635 : 0 : ABI_BUG(msg)
636 : : end if
637 : :
638 [ # # ]: 0 : if (use_results_all) then
639 : 0 : results_out_all_size=size(results_out_all)
640 [ # # ]: 0 : if (results_out_size/=results_out_all_size) then
641 : 0 : msg=' Wrong size for results_out_all datastructure !'
642 : 0 : ABI_BUG(msg)
643 : : end if
644 : : end if
645 : :
646 [ # # ]: 0 : if (results_out_size>0) then
647 : :
648 [ # # ]: 0 : idt1=lbound(results_out,1);idt2=ubound(results_out,1)
649 : :
650 : : ! Create global results_out_all datastructure
651 [ # # ]: 0 : if (use_results_all) then
652 : 0 : mxnatom=1;mxnband=1;mxnkpt=1;mxnpsp=1;mxntypat=1
653 [ # # ]: 0 : do ii=idt1,idt2
654 [ # # ]: 0 : isize=size(results_out(ii)%fcart,2) ;if (isize>mxnatom) mxnatom=isize
655 [ # # ]: 0 : isize=size(results_out(ii)%occ,1) ;if (isize>mxnband) mxnband=isize
656 [ # # ]: 0 : isize=size(results_out(ii)%mixalch,1);if(isize>mxnpsp) mxnpsp=isize
657 [ # # ]: 0 : isize=size(results_out(ii)%npwtot,1);if (isize>mxnkpt) mxnkpt=isize
658 [ # # ]: 0 : isize=size(results_out(ii)%mixalch,2);if(isize>mxntypat) mxntypat=isize
659 : : end do
660 : 0 : mxnband=mxnband/mxnkpt;mxnsppol=1
661 : 0 : call init_results_out(dtsets,2,0,mpi_enregs,mxnatom,mxnband,mxnkpt,mxnpsp,mxnsppol,mxntypat,results_out_all)
662 : : end if
663 : :
664 : : ! Loop over results_out components (datasets)
665 [ # # ]: 0 : do ii=idt1,idt2
666 : :
667 : : ! Simple copy in case of 1 image
668 [ # # ]: 0 : if (dtsets(ii)%npimage<=1) then
669 [ # # ]: 0 : if (use_results_all) then
670 : 0 : call copy_results_out(results_out(ii),results_out_all(ii))
671 : : end if
672 : : else
673 : :
674 : : ! Retrieve MPI information for this dataset
675 : :
676 [ # # # # ]: 0 : if ((.not.one_per_img).or.(mpi_enregs(ii)%me_cell==master_one_img)) then
677 : :
678 : : ! Gather number of images treated by each proc
679 [ # # # # : 0 : ABI_MALLOC(nimage_all,(mpi_enregs(ii)%nproc_img))
# # # # #
# # # #
# ]
680 [ # # ]: 0 : nimage_all=0
681 : 0 : nimage=results_out(ii)%nimage
682 : 0 : call xmpi_allgather(nimage,nimage_all,mpi_enregs(ii)%comm_img,ierr)
683 [ # # ]: 0 : nimagetot=sum(nimage_all)
684 : :
685 : : ! Copy scalars from distributed results_out to gathered one
686 [ # # ]: 0 : if (use_results_all) then
687 : 0 : results_out_all(ii)%nimage=nimagetot
688 : 0 : results_out_all(ii)%natom =results_out(ii)%natom
689 : 0 : results_out_all(ii)%nkpt =results_out(ii)%nkpt
690 : 0 : results_out_all(ii)%nocc =results_out(ii)%nocc
691 : 0 : results_out_all(ii)%npsp =results_out(ii)%npsp
692 : 0 : results_out_all(ii)%ntypat=results_out(ii)%ntypat
693 : : end if
694 : :
695 : : ! Compute number of integers/reals needed by current
696 : : ! results_out structure for current proc
697 : 0 : isize=results_out(ii)%nkpt
698 : 0 : rsize=28+16*results_out(ii)%natom+results_out(ii)%nocc+results_out(ii)%npsp*results_out(ii)%ntypat+results_out(ii)%ntypat
699 : 0 : isize_img=results_out(ii)%nimage*isize
700 : 0 : rsize_img=results_out(ii)%nimage*rsize
701 [ # # # # : 0 : ABI_MALLOC(isize_img_all,(mpi_enregs(ii)%nproc_img))
# # # # #
# # # #
# ]
702 [ # # # # : 0 : ABI_MALLOC(rsize_img_all,(mpi_enregs(ii)%nproc_img))
# # # # #
# ]
703 [ # # ]: 0 : isize_img_all(:)=isize*nimage_all(:)
704 [ # # ]: 0 : rsize_img_all(:)=rsize*nimage_all(:)
705 [ # # ]: 0 : ABI_FREE(nimage_all)
706 : :
707 : : ! Compute shifts in buffer arrays for each proc
708 [ # # # # : 0 : ABI_MALLOC(ibufshft,(mpi_enregs(ii)%nproc_img))
# # # # #
# # # #
# ]
709 : 0 : ibufshft(1)=0
710 [ # # # # : 0 : ABI_MALLOC(rbufshft,(mpi_enregs(ii)%nproc_img))
# # # # #
# ]
711 : 0 : rbufshft(1)=0
712 [ # # ]: 0 : do jj=2,mpi_enregs(ii)%nproc_img
713 : 0 : ibufshft(jj)=ibufshft(jj-1)+isize_img_all(jj-1)
714 : 0 : rbufshft(jj)=rbufshft(jj-1)+rsize_img_all(jj-1)
715 : : end do
716 : :
717 : : ! Load buffers
718 [ # # # # : 0 : ABI_MALLOC(ibuffer,(isize_img))
# # # # #
# # # #
# ]
719 [ # # # # : 0 : ABI_MALLOC(rbuffer,(rsize_img))
# # # # #
# # # #
# ]
720 : 0 : ibufi=0;ibufr=0
721 : 0 : natom_=results_out(ii)%natom
722 : 0 : nkpt_ =results_out(ii)%nkpt
723 : 0 : nocc_ =results_out(ii)%nocc
724 : 0 : npsp_ =results_out(ii)%npsp
725 : 0 : ntypat_ =results_out(ii)%ntypat
726 [ # # ]: 0 : do jj=1,results_out(ii)%nimage
727 [ # # ]: 0 : ibuffer(ibufi+1:ibufi+nkpt_)=results_out(ii)%npwtot(1:nkpt_,jj)
728 : 0 : ibufi=ibufi+nkpt_
729 [ # # ]: 0 : rbuffer(ibufr+1:ibufr+3)=results_out(ii)%acell(1:3,jj)
730 : 0 : ibufr=ibufr+3
731 [ # # ]: 0 : rbuffer(ibufr+1:ibufr+ntypat_)=results_out(ii)%amu(1:ntypat_,jj)
732 : 0 : ibufr=ibufr+ntypat_
733 : 0 : rbuffer(ibufr+1)=results_out(ii)%etotal(jj)
734 : 0 : ibufr=ibufr+1
735 [ # # ]: 0 : rbuffer(ibufr+1:ibufr+3*natom_)=reshape(results_out(ii)%fcart(1:3,1:natom_,jj),(/3*natom_/))
736 : 0 : ibufr=ibufr+3*natom_
737 [ # # ]: 0 : rbuffer(ibufr+1:ibufr+3*natom_)=reshape(results_out(ii)%gred(1:3,1:natom_,jj),(/3*natom_/))
738 : 0 : ibufr=ibufr+3*natom_
739 [ # # ]: 0 : rbuffer(ibufr+1:ibufr+4*natom_)=reshape(results_out(ii)%intgres(1:4,1:natom_,jj),(/4*natom_/))
740 : 0 : ibufr=ibufr+4*natom_
741 : : rbuffer(ibufr+1:ibufr+npsp_*ntypat_)=&
742 [ # # ]: 0 : & reshape(results_out(ii)%mixalch(1:npsp_,1:ntypat_,jj),(/npsp_*ntypat_/) )
743 : 0 : ibufr=ibufr+npsp_*ntypat_
744 [ # # ]: 0 : rbuffer(ibufr+1:ibufr+nocc_)=results_out(ii)%occ(1:nocc_,jj)
745 : 0 : ibufr=ibufr+nocc_
746 : 0 : rbuffer(ibufr+1:ibufr+9)=reshape(results_out(ii)%rprim(1:3,1:3,jj),(/9/))
747 : 0 : ibufr=ibufr+9
748 : 0 : rbuffer(ibufr+1:ibufr+9)=reshape(results_out(ii)%vel_cell(1:3,1:3,jj),(/9/))
749 : 0 : ibufr=ibufr+9
750 [ # # ]: 0 : rbuffer(ibufr+1:ibufr+6)=results_out(ii)%strten(1:6,jj)
751 : 0 : ibufr=ibufr+6
752 [ # # ]: 0 : rbuffer(ibufr+1:ibufr+3*natom_)=reshape(results_out(ii)%vel(1:3,1:natom_,jj),(/3*natom_/))
753 : 0 : ibufr=ibufr+3*natom_
754 [ # # ]: 0 : rbuffer(ibufr+1:ibufr+3*natom_)=reshape(results_out(ii)%xred(1:3,1:natom_,jj),(/3*natom_/))
755 : 0 : ibufr=ibufr+3*natom_
756 : : end do
757 [ # # ]: 0 : if (ibufi/=isize_img.or.ibufr/=rsize_img) then
758 : 0 : msg=' wrong buffer sizes !'
759 : 0 : ABI_BUG(msg)
760 : : end if
761 : :
762 : : ! Gather all data
763 [ # # ]: 0 : if (use_results_all) then
764 [ # # # # : 0 : ABI_MALLOC(ibuffer_all,(isize*nimagetot))
# # # # #
# # # #
# ]
765 [ # # # # : 0 : ABI_MALLOC(rbuffer_all,(rsize*nimagetot))
# # # # #
# # # #
# ]
766 : : end if
767 [ # # ]: 0 : if (.not.use_results_all) then
768 [ # # # # ]: 0 : ABI_MALLOC(ibuffer_all,(0))
769 [ # # # # ]: 0 : ABI_MALLOC(rbuffer_all,(0))
770 : : end if
771 [ # # ]: 0 : if (do_allgather) then
772 : : call xmpi_allgatherv(ibuffer,isize_img,ibuffer_all,isize_img_all,ibufshft,&
773 : 0 : & mpi_enregs(ii)%comm_img,ierr)
774 : : call xmpi_allgatherv(rbuffer,rsize_img,rbuffer_all,rsize_img_all,rbufshft,&
775 : 0 : & mpi_enregs(ii)%comm_img,ierr)
776 : : else
777 : : call xmpi_gatherv(ibuffer,isize_img,ibuffer_all,isize_img_all,ibufshft,&
778 : 0 : & master_img,mpi_enregs(ii)%comm_img,ierr)
779 : : call xmpi_gatherv(rbuffer,rsize_img,rbuffer_all,rsize_img_all,rbufshft,&
780 : 0 : & master_img,mpi_enregs(ii)%comm_img,ierr)
781 : : end if
782 [ # # ]: 0 : ABI_FREE(isize_img_all)
783 [ # # ]: 0 : ABI_FREE(rsize_img_all)
784 [ # # ]: 0 : ABI_FREE(ibuffer)
785 [ # # ]: 0 : ABI_FREE(rbuffer)
786 : :
787 : : ! Transfer buffers into gathered results_out_all (master proc only)
788 [ # # ]: 0 : if (use_results_all) then
789 [ # # # # : 0 : ABI_MALLOC(iimg,(mpi_enregs(ii)%nproc_img))
# # # # #
# # # ]
790 [ # # ]: 0 : iimg=0
791 : 0 : natom_=results_out_all(ii)%natom
792 : 0 : nkpt_=results_out_all(ii)%nkpt
793 : 0 : nocc_=results_out_all(ii)%nocc
794 : 0 : npsp_ =results_out_all(ii)%npsp
795 : 0 : ntypat_ =results_out_all(ii)%ntypat
796 [ # # ]: 0 : do jj=1,nimagetot
797 : : ! The following line supposes that images are sorted by increasing index
798 : 0 : iproc=mpi_enregs(ii)%distrb_img(jj)+1;iimg(iproc)=iimg(iproc)+1
799 : 0 : ibufi=ibufshft(iproc)+(iimg(iproc)-1)*isize
800 : 0 : ibufr=rbufshft(iproc)+(iimg(iproc)-1)*rsize
801 [ # # ]: 0 : results_out_all(ii)%npwtot(1:nkpt_,jj)=ibuffer_all(ibufi+1:ibufi+nkpt_)
802 : 0 : ibufi=ibufi+nkpt_
803 [ # # ]: 0 : results_out_all(ii)%acell(1:3,jj)=rbuffer_all(ibufr+1:ibufr+3)
804 : 0 : ibufr=ibufr+3
805 [ # # ]: 0 : results_out_all(ii)%amu(1:ntypat_,jj)=rbuffer_all(ibufr+1:ibufr+ntypat_)
806 : 0 : ibufr=ibufr+ntypat_
807 : 0 : results_out_all(ii)%etotal(jj)=rbuffer_all(ibufr+1)
808 : 0 : ibufr=ibufr+1
809 : : results_out_all(ii)%fcart(1:3,1:natom_,jj)= &
810 [ # # # # : 0 : & reshape(rbuffer_all(ibufr+1:ibufr+3*natom_),(/3,natom_/))
# # ]
811 : 0 : ibufr=ibufr+3*natom_
812 : : results_out_all(ii)%gred(1:3,1:natom_,jj)= &
813 [ # # # # : 0 : & reshape(rbuffer_all(ibufr+1:ibufr+3*natom_),(/3,natom_/))
# # ]
814 : 0 : ibufr=ibufr+3*natom_
815 : : results_out_all(ii)%intgres(1:4,1:natom_,jj)= &
816 [ # # # # : 0 : & reshape(rbuffer_all(ibufr+1:ibufr+4*natom_),(/4,natom_/))
# # ]
817 : 0 : ibufr=ibufr+4*natom_
818 : : results_out_all(ii)%mixalch(1:npsp_,1:ntypat_,jj)= &
819 [ # # # # : 0 : & reshape(rbuffer_all(ibufr+1:ibufr+npsp_*ntypat_),(/npsp_,ntypat_/))
# # ]
820 : 0 : ibufr=ibufr+npsp_*ntypat_
821 [ # # ]: 0 : results_out_all(ii)%occ(1:nocc_,jj)=rbuffer_all(ibufr+1:ibufr+nocc_)
822 : 0 : ibufr=ibufr+nocc_
823 [ # # # # ]: 0 : results_out_all(ii)%rprim(1:3,1:3,jj)=reshape(rbuffer_all(ibufr+1:ibufr+9),(/3,3/))
824 : 0 : ibufr=ibufr+9
825 [ # # # # ]: 0 : results_out_all(ii)%vel_cell(1:3,1:3,jj)=reshape(rbuffer_all(ibufr+1:ibufr+9),(/3,3/))
826 : 0 : ibufr=ibufr+9
827 [ # # ]: 0 : results_out_all(ii)%strten(1:6,jj)=rbuffer_all(ibufr+1:ibufr+6)
828 : 0 : ibufr=ibufr+6
829 : : results_out_all(ii)%vel(1:3,1:natom_,jj)= &
830 [ # # # # : 0 : & reshape(rbuffer_all(ibufr+1:ibufr+3*natom_),(/3,natom_/))
# # ]
831 : 0 : ibufr=ibufr+3*natom_
832 : : results_out_all(ii)%xred(1:3,1:natom_,jj)= &
833 [ # # # # : 0 : & reshape(rbuffer_all(ibufr+1:ibufr+3*natom_),(/3,natom_/))
# # ]
834 : 0 : ibufr=ibufr+3*natom_
835 : : end do
836 [ # # ]: 0 : ABI_FREE(iimg)
837 : : end if
838 : :
839 : : ! Free memory
840 : 0 : ABI_FREE(ibufshft)
841 : 0 : ABI_FREE(rbufshft)
842 [ # # ]: 0 : ABI_FREE(ibuffer_all)
843 [ # # ]: 0 : ABI_FREE(rbuffer_all)
844 : :
845 : : end if
846 : : end if
847 : : end do
848 : : end if
849 : :
850 [ # # # # : 0 : end subroutine gather_results_out
# # # # #
# # # # #
# # # # ]
851 : : !!***
852 : :
853 : 0 : END MODULE m_results_out
854 : : !!***
|
