Line data Source code
1 : !!****m* ABINIT/m_driver
2 : !! NAME
3 : !! m_driver
4 : !!
5 : !! FUNCTION
6 : !!
7 : !! COPYRIGHT
8 : !! Copyright (C) 2008-2026 ABINIT group ()
9 : !! This file is distributed under the terms of the
10 : !! GNU General Public License, see ~abinit/COPYING
11 : !! or http://www.gnu.org/copyleft/gpl.txt .
12 : !!
13 : !! SOURCE
14 :
15 : #if defined HAVE_CONFIG_H
16 : #include "config.h"
17 : #endif
18 :
19 : #include "abi_common.h"
20 :
21 : module m_driver
22 :
23 : use defs_basis
24 : use defs_wvltypes
25 : use m_errors
26 : use m_dtset
27 : use m_results_out
28 : use m_results_respfn
29 : use m_yaml
30 : use m_xmpi
31 : use m_xomp
32 : use m_abi_linalg
33 : use m_abicore
34 : use m_exit
35 : use m_dtfil
36 : use m_fftcore
37 : use libxc_functionals
38 : use m_longwave
39 : #if defined DEV_YP_VDWXC
40 : use m_xc_vdw
41 : #endif
42 : use m_xgScalapack
43 : #ifdef HAVE_LINALG_ELPA
44 : use m_elpa
45 : #endif
46 :
47 : use defs_datatypes, only : pseudopotential_type, pspheader_type
48 : use defs_abitypes, only : MPI_type
49 : use m_fstrings, only : sjoin, itoa
50 : use m_time, only : timab, cwtime, cwtime_report
51 : use m_pstat, only : pstat_proc
52 : use m_xg, only : xg_finalize
53 : use m_libpaw_tools, only : libpaw_write_comm_set
54 : use m_geometry, only : mkrdim, xcart2xred, xred2xcart, chkdilatmx
55 : use m_pawang, only : pawang_type, pawang_free
56 : use m_pawrad, only : pawrad_type, pawrad_free
57 : use m_pawtab, only : pawtab_type, pawtab_nullify, pawtab_free
58 : use m_fftw3, only : fftw3_init_threads, fftw3_cleanup
59 : use m_psps, only : psps_init_global, psps_init_from_dtset, psps_free
60 : use m_mpinfo, only : mpi_distrib_is_ok
61 : use m_respfn_driver, only : respfn
62 : use m_screening_driver, only : screening
63 : use m_sigma_driver, only : sigma
64 : use m_bethe_salpeter, only : bethe_salpeter
65 : use m_gwr_driver, only : gwr_driver
66 : use m_eph_driver, only : eph
67 : use m_wfk_analyze, only : wfk_analyze
68 : use m_gstateimg, only : gstateimg
69 : use m_gwls_sternheimer, only : gwls_sternheimer
70 : use m_nonlinear, only : nonlinear
71 : use m_drivexc, only : echo_xc_name
72 : use m_rttddft_driver, only : rttddft
73 :
74 : #if defined HAVE_BIGDFT
75 : use BigDFT_API, only: xc_init, xc_end, XC_MIXED, XC_ABINIT,&
76 : & mpi_environment_set,bigdft_mpi, f_malloc_set_status
77 : #endif
78 :
79 : implicit none
80 :
81 : private
82 : !!***
83 :
84 : public :: driver
85 : !!***
86 :
87 : contains
88 : !!***
89 :
90 : !!****f* ABINIT/driver
91 : !! NAME
92 : !! driver
93 : !!
94 : !! FUNCTION
95 : !! Driver for ground state, response function, screening
96 : !! and sigma calculations. The present routine drives the following operations.
97 : !! An outer loop allows computation related to different data sets.
98 : !! For each data set, either a GS calculation, a RF calculation,
99 : !! a SUS calculation, a SCR calculation or a SIGMA calculation is made.
100 : !! In both cases, the input variables are transferred in the proper variables,
101 : !! selected big arrays are allocated, then the gstate, respfn, ... subroutines are called.
102 : !!
103 : !! COPYRIGHT
104 : !! Copyright (C) 1999-2026 ABINIT group (XG,MKV,MM,MT,FJ)
105 : !! This file is distributed under the terms of the
106 : !! GNU General Public License, see ~abinit/COPYING
107 : !! or http://www.gnu.org/copyleft/gpl.txt .
108 : !! For the initials of contributors, see ~abinit/doc/developers/contributors.txt .
109 : !!
110 : !! INPUTS
111 : !! codvsn= code version
112 : !! cpui=initial CPU time
113 : !! filnam(5)=character strings giving file names
114 : !! filstat=character strings giving name of status file
115 : !! mpi_enregs=information about MPI parallelization
116 : !! ndtset=number of datasets
117 : !! ndtset_alloc=number of datasets, corrected for allocation of at least one data set.
118 : !! npsp=number of pseudopotentials
119 : !! pspheads(npsp)=<type pspheader_type>all the important informatio from the
120 : !! pseudopotential file header, as well as the psp file name
121 : !!
122 : !! OUTPUT
123 : !!
124 : !! SIDE EFFECTS
125 : !! Input/Output
126 : !! results_out(0:ndtset_alloc)=<type results_out_type>contains the results
127 : !! needed for outvars, including evolving variables
128 : !! Default values are set up in the calling routine
129 : !! dtsets(0:ndtset_alloc)=<type datasets_type>
130 : !! input: all input variables initialized from the input file.
131 : !! output: the effective set of variables used in the different datasets.
132 : !! Some variables, indeed, might have been redefined in one of the children.
133 : !! of this routine.
134 : !!
135 : !! NOTES
136 : !! The array filnam is used for the name of input and output files,
137 : !! and roots for generic input, output or temporary files.
138 : !! Pseudopotential file names are set in pspini and pspatm,
139 : !! using another name. The name filstat will be needed beyond gstate to check
140 : !! the appearance of the "exit" flag, to make a hasty exit, as well as
141 : !! in order to output the status of the computation.
142 : !!
143 : !! SOURCE
144 :
145 1391 : subroutine driver(codvsn,cpui,dtsets,filnam,filstat,&
146 1391 : & mpi_enregs,ndtset,ndtset_alloc,npsp,pspheads,results_out)
147 :
148 : !Arguments ------------------------------------
149 : !scalars
150 : integer,intent(in) :: ndtset,ndtset_alloc,npsp
151 : real(dp),intent(in) :: cpui
152 : character(len=8),intent(in) :: codvsn
153 : character(len=fnlen),intent(in) :: filstat
154 : type(MPI_type),intent(inout) :: mpi_enregs(0:ndtset_alloc)
155 : !arrays
156 : character(len=fnlen),intent(in) :: filnam(5)
157 : type(dataset_type),intent(inout) :: dtsets(0:ndtset_alloc)
158 : type(pspheader_type),intent(in) :: pspheads(npsp)
159 : type(results_out_type),target,intent(inout) :: results_out(0:ndtset_alloc)
160 :
161 : !Local variables-------------------------------
162 : !scalars
163 : #if defined DEV_YP_VDWXC
164 : character(len=fnlen) :: vdw_filnam
165 : #endif
166 : integer,parameter :: level=2,mdtset=9999
167 : integer,save :: paw_size_old=-1
168 : integer :: idtset,ierr,iexit,iget_cell,iget_occ,iget_vel,iget_xcart,iget_xred
169 : integer :: ii,iimage,iimage_get,jdtset,jdtset_status,jj,kk,linalg_max_size
170 : integer :: mtypalch,mu,mxnimage,nimage,openexit,paw_size,prtvol, omp_nthreads
171 : real(dp) :: el_temp,etotal, cpu, wall, gflops
172 : character(len=500) :: msg, dilatmx_errmsg
173 : logical :: results_gathered,test_img,use_results_all
174 178048 : type(dataset_type) :: dtset
175 : type(datafiles_type) :: dtfil
176 1391 : type(pawang_type) :: pawang
177 1391 : type(pseudopotential_type) :: psps
178 1391 : type(results_respfn_type) :: results_respfn
179 1391 : type(wvl_data) :: wvl
180 : type(yamldoc_t) :: ydoc
181 : #if defined DEV_YP_VDWXC
182 : type(xc_vdw_type) :: vdw_params
183 : #endif
184 : !arrays
185 : integer :: mkmems(3)
186 1391 : integer,allocatable :: jdtset_(:),npwtot(:)
187 : real(dp) :: acell(3),rprim(3,3),rprimd(3,3),tsec(2)
188 1391 : real(dp),allocatable :: acell_img(:,:),amu_img(:,:),rprim_img(:,:,:)
189 1391 : real(dp),allocatable :: fcart_img(:,:,:),gred_img(:,:,:),intgres_img(:,:,:)
190 1391 : real(dp),allocatable :: etotal_img(:),mixalch_img(:,:,:),strten_img(:,:),miximage(:,:)
191 1391 : real(dp),allocatable :: occ(:),xcart(:,:),xred(:,:),xredget(:,:)
192 1391 : real(dp),allocatable :: occ_img(:,:),vel_cell_img(:,:,:),vel_img(:,:,:),xred_img(:,:,:)
193 1391 : type(pawrad_type),allocatable :: pawrad(:)
194 1391 : type(pawtab_type),allocatable :: pawtab(:)
195 1391 : type(results_out_type),pointer :: results_out_all(:)
196 :
197 : !******************************************************************
198 :
199 : DBG_ENTER("COLL")
200 :
201 1391 : call timab(640,1,tsec)
202 1391 : call timab(641,3,tsec)
203 :
204 : !Structured debugging if prtvol==-level
205 1391 : prtvol=dtsets(1)%prtvol
206 1391 : if(prtvol==-level)then
207 0 : write(msg,'(80a,a,a)') ('=',ii=1,80),ch10,' driver : enter , debug mode '
208 0 : call wrtout(std_out, msg)
209 : end if
210 :
211 1391 : if(ndtset>mdtset)then
212 0 : write(msg,'(a,i0,a,i0,a)')' The maximal allowed ndtset is ',mdtset,' while the input value is ',ndtset,'.'
213 0 : ABI_BUG(msg)
214 : end if
215 :
216 1391 : mtypalch=dtsets(1)%ntypalch
217 6672 : do ii=1,ndtset_alloc
218 6672 : mtypalch=max(dtsets(ii)%ntypalch,mtypalch)
219 : end do
220 1391 : call psps_init_global(psps, mtypalch, npsp, pspheads)
221 :
222 4173 : ABI_MALLOC(jdtset_,(0:ndtset))
223 1391 : if(ndtset/=0)then
224 6875 : jdtset_(:)=dtsets(0:ndtset)%jdtset
225 : else
226 396 : jdtset_(0)=0
227 : end if
228 :
229 6672 : do idtset=1,ndtset_alloc
230 6672 : call results_respfn%init(dtsets,ndtset_alloc)
231 : end do
232 :
233 1391 : call timab(641,2,tsec)
234 :
235 : #ifdef HAVE_LINALG_ELPA
236 : call elpa_func_init()
237 : #endif
238 :
239 : !*********************************************************************
240 : !Big loop on datasets
241 6672 : do idtset=1,ndtset_alloc
242 :
243 5281 : if(mpi_enregs(idtset)%me<0) cycle
244 :
245 5281 : call cwtime(cpu, wall, gflops, "start")
246 5281 : call timab(642,1,tsec)
247 5281 : call abi_io_redirect(new_io_comm=mpi_enregs(idtset)%comm_world)
248 5281 : call libpaw_write_comm_set(mpi_enregs(idtset)%comm_world)
249 :
250 5281 : jdtset=dtsets(idtset)%jdtset ; if(ndtset==0)jdtset=1
251 :
252 : if(ndtset>=2)then
253 : jdtset_status=jdtset
254 : else
255 : jdtset_status=0
256 : end if
257 :
258 : ! Copy input variables into a local dtset.
259 5281 : dtset = dtsets(idtset)%copy()
260 :
261 : ! Set other values
262 5281 : dtset%jdtset = jdtset
263 5281 : dtset%ndtset = ndtset
264 :
265 : ! Print DATASET number
266 427761 : write(msg,'(83a)') ch10,('=',mu=1,80),ch10,'== DATASET'
267 5281 : if (jdtset>=100) then
268 12090 : write(msg,'(2a,i4,65a)') trim(msg),' ',jdtset,' ',('=',mu=1,64)
269 : else
270 341365 : write(msg,'(2a,i2,67a)') trim(msg),' ',jdtset,' ',('=',mu=1,66)
271 : end if
272 :
273 : #ifdef HAVE_OPENMP
274 : omp_nthreads = xomp_get_num_threads(open_parallel=.True.)
275 : #else
276 5281 : omp_nthreads = -1
277 : #endif
278 5281 : write(msg,'(2a,2(a, i0), a)') trim(msg),ch10,&
279 10562 : '- mpi_nproc: ',mpi_enregs(idtset)%nproc, ", omp_nthreads: ", omp_nthreads, " (-1 if OMP is not activated)"
280 :
281 5281 : if (dtset%optdriver == RUNL_GSTATE) then
282 3967 : if (.not. mpi_distrib_is_ok(mpi_enregs(idtset),dtset%mband,dtset%nkpt,dtset%mkmem,dtset%nsppol)) then
283 74 : write(msg,'(3a)') trim(msg),ch10,'- --> not optimal distribution: autoparal keyword recommended in input file <--'
284 : end if
285 : end if
286 :
287 5281 : write(msg,'(3a)') trim(msg),ch10,' '
288 5281 : call wrtout(ab_out, msg)
289 5281 : call wrtout(std_out, msg, 'PERS') ! PERS is choosen to make debugging easier
290 :
291 5281 : call yaml_iterstart('dtset', jdtset, ab_out, dtset%use_yaml)
292 :
293 5281 : if (mpi_enregs(idtset)%me_cell == 0) then
294 4396 : ydoc = yamldoc_open('DatasetInfo')
295 :
296 : ! Write basic dimensions.
297 : call ydoc%add_ints( &
298 : "natom, nkpt, mband, nsppol, nspinor, nspden, mpw", &
299 : [dtset%natom, dtset%nkpt, dtset%mband, dtset%nsppol, dtset%nspinor, dtset%nspden, dtset%mpw], &
300 35168 : dict_key="dimensions")
301 :
302 : ! Write cutoff energies.
303 : call ydoc%add_reals("ecut, pawecutdg", [dtset%ecut, dtset%pawecutdg], &
304 13188 : real_fmt="(f5.1)", dict_key="cutoff_energies")
305 :
306 : ! Write info on electrons.
307 : call ydoc%add_reals("nelect, charge, occopt, tsmear", &
308 : [dtset%nelect, dtset%cellcharge(1), one * dtset%occopt, dtset%tsmear], &
309 21980 : dict_key="electrons")
310 :
311 : ! This part depends on optdriver.
312 : ! Third-party Yaml parsers may use optdriver to specialize the logic used to interpret the next data.
313 7667 : select case (dtset%optdriver)
314 : case (RUNL_GSTATE)
315 : call ydoc%add_ints("optdriver, ionmov, optcell, iscf, paral_kgb", &
316 : [dtset%optdriver, dtset%ionmov, dtset%optcell, dtset%iscf, dtset%paral_kgb], &
317 19626 : dict_key="meta")
318 :
319 : case (RUNL_RESPFN)
320 : call ydoc%add_ints("optdriver, rfddk, rfelfd, rfmagn, rfphon, rfstrs", &
321 : [dtset%optdriver, dtset%rfddk, dtset%rfelfd, dtset%rfmagn, dtset%rfphon, dtset%rfstrs], &
322 4354 : ignore=0, dict_key="meta")
323 : ! dtset%rfdir ??
324 :
325 : case (RUNL_NONLINEAR)
326 : call ydoc%add_ints("optdriver", [dtset%optdriver], &
327 48 : dict_key="meta")
328 :
329 : case (RUNL_GWLS)
330 : call ydoc%add_ints("optdriver", [dtset%optdriver], &
331 10 : dict_key="meta")
332 :
333 : case (RUNL_WFK)
334 : call ydoc%add_ints("optdriver, wfk_task", &
335 36 : [dtset%optdriver, dtset%wfk_task] , dict_key="meta")
336 :
337 : case (RUNL_SCREENING, RUNL_SIGMA)
338 : call ydoc%add_ints("optdriver, gwcalctyp", &
339 879 : [dtset%optdriver, dtset%gwcalctyp] , dict_key="meta")
340 :
341 : case (RUNL_GWR)
342 0 : call ydoc%add_ints("optdriver", [dtset%optdriver], dict_key="meta")
343 :
344 : case (RUNL_BSE)
345 : call ydoc%add_ints("optdriver, bs_calctype, bs_algorithm", &
346 100 : [dtset%optdriver, dtset%bs_calctype, dtset%bs_algorithm] , dict_key="meta")
347 :
348 : case (RUNL_EPH)
349 327 : call ydoc%add_ints("optdriver, eph_task", [dtset%optdriver, dtset%eph_task] , dict_key="meta")
350 :
351 : case (RUNL_LONGWAVE)
352 34 : call ydoc%add_ints("optdriver", [dtset%optdriver], dict_key="meta")
353 :
354 : case (RUNL_RTTDDFT)
355 36 : call ydoc%add_ints("optdriver", [dtset%optdriver], dict_key="meta")
356 :
357 : case default
358 4396 : ABI_ERROR(sjoin('Add a meta section for optdriver: ', itoa(dtset%optdriver)))
359 : end select
360 :
361 : !if (dtset%use_yaml == 1) then
362 4396 : call ydoc%write_and_free(ab_out)
363 : !else
364 : ! call ydoc%write_and_free(std_out)
365 : !end if
366 : end if
367 :
368 5281 : if ( dtset%np_slk == 0 ) then
369 0 : call xgScalapack_config(SLK_DISABLED,dtset%slk_rankpp)
370 5281 : else if ( dtset%np_slk == 1000000 ) then
371 5237 : call xgScalapack_config(SLK_AUTO,dtset%slk_rankpp)
372 44 : else if ( dtset%np_slk > 1 ) then
373 44 : call xgScalapack_config(dtset%np_slk,dtset%slk_rankpp)
374 : else
375 0 : call xgScalapack_config(SLK_AUTO,dtset%slk_rankpp)
376 : end if
377 :
378 : ! Copy input values
379 5281 : mkmems(1) = dtset%mkmem
380 5281 : mkmems(2) = dtset%mkqmem
381 5281 : mkmems(3) = dtset%mk1mem
382 :
383 : ! Initialize MPI data for the parallelism over images
384 5281 : nimage=mpi_enregs(idtset)%my_nimage
385 :
386 : ! Retrieve evolving arrays (most of them depend on images)
387 15843 : ABI_MALLOC(acell_img,(3,nimage))
388 21124 : ABI_MALLOC(amu_img,(dtset%ntypat,nimage))
389 26405 : ABI_MALLOC(mixalch_img,(dtset%npspalch,dtset%ntypalch,nimage))
390 21124 : ABI_MALLOC(occ_img,(dtset%mband*dtset%nkpt*dtset%nsppol,nimage))
391 15843 : ABI_MALLOC(rprim_img,(3,3,nimage))
392 21124 : ABI_MALLOC(vel_img,(3,dtset%natom,nimage))
393 10562 : ABI_MALLOC(vel_cell_img,(3,3,nimage))
394 15843 : ABI_MALLOC(xred_img,(3,dtset%natom,nimage))
395 10822 : do iimage=1,nimage
396 5541 : ii=mpi_enregs(idtset)%my_imgtab(iimage)
397 22164 : acell_img (: ,iimage) = dtset%acell_orig(:,ii)
398 12907 : amu_img (: ,iimage) = dtset%amu_orig(1:dtset%ntypat,ii)
399 5619 : mixalch_img (:,:,iimage) =dtset%mixalch_orig(1:dtset%npspalch,1:dtset%ntypalch,ii)
400 72033 : rprim_img (:,:,iimage) = dtset%rprim_orig(:,:,ii)
401 57437 : vel_img (:,:,iimage) = dtset%vel_orig(:,1:dtset%natom,ii)
402 72033 : vel_cell_img(:,:,iimage) = dtset%vel_cell_orig(:,:,ii)
403 57437 : xred_img (:,:,iimage) = dtset%xred_orig(:,1:dtset%natom,ii)
404 902225 : occ_img (: ,iimage) = dtset%occ_orig(1:dtset%mband*dtset%nkpt*dtset%nsppol,ii)
405 : end do
406 :
407 : ! ****************************************************************************
408 : ! Treat the file names (get variables)
409 :
410 : ! In the case of multiple images, the file names will be overwritten later (for each image)
411 5281 : call dtfil%init(dtset,filnam,filstat,idtset,jdtset_,mpi_enregs(idtset),ndtset)
412 5281 : if (dtset%optdriver==RUNL_GSTATE.and.dtset%nimage>1) then
413 50 : call dtfil%init_img(dtset,dtsets,idtset,jdtset_,ndtset,ndtset_alloc)
414 : end if
415 :
416 : ! ****************************************************************************
417 : ! Treat other get variables
418 :
419 : ! If multi dataset mode, and already the second dataset,
420 : ! treatment of other get variables.
421 5281 : if( ndtset>1 .and. idtset>1 )then
422 :
423 : ! Check if parallelization over images is activated
424 85962 : mxnimage=maxval(dtsets(1:ndtset_alloc)%nimage)
425 15560 : ABI_MALLOC(miximage,(mxnimage,mxnimage))
426 89852 : test_img=(mxnimage/=1.and.maxval(dtsets(:)%npimage)>1)
427 3890 : use_results_all=.false.
428 3890 : if (test_img.and.mpi_enregs(idtset)%me_cell==0) then
429 0 : use_results_all=.true.
430 0 : ABI_MALLOC(results_out_all,(0:ndtset_alloc))
431 : else
432 3890 : results_out_all => results_out
433 : end if
434 3890 : results_gathered=.false.
435 :
436 3890 : call find_getdtset(dtsets,dtset%getocc,'getocc',idtset,iget_occ,miximage,mxnimage,ndtset_alloc)
437 3890 : if(iget_occ/=0)then
438 : ! Gather contributions to results_out from images, if needed
439 7 : if (test_img.and.mpi_enregs(idtset)%me_cell==0.and.(.not.results_gathered)) then
440 : call gather_results_out(dtsets,mpi_enregs,results_out,results_out_all,use_results_all, &
441 0 : allgather=.true.,only_one_per_img=.true.)
442 0 : results_gathered=.true.
443 : end if
444 0 : if ((.not.test_img).or.mpi_enregs(idtset)%me_cell==0) then
445 14 : do iimage=1,nimage
446 7 : ii=mpi_enregs(idtset)%my_imgtab(iimage)
447 85 : occ_img(:,iimage)=zero
448 21 : do iimage_get=1,dtsets(iget_occ)%nimage
449 92 : do jj=1,dtset%mband*dtset%nkpt*dtset%nsppol
450 : occ_img(jj,iimage)=occ_img(jj,iimage)+miximage(ii,iimage_get) &
451 85 : & *results_out_all(iget_occ)%occ(jj,iimage_get)
452 : end do
453 : end do
454 : end do
455 : end if
456 : end if
457 :
458 : ! Getcell has to be treated BEFORE getxcart since acell and rprim will be used
459 3890 : call find_getdtset(dtsets,dtset%getcell,'getcell',idtset,iget_cell,miximage,mxnimage,ndtset_alloc)
460 3890 : if(iget_cell/=0)then
461 : ! Gather contributions to results_out from images, if needed
462 14 : if (test_img.and.mpi_enregs(idtset)%me_cell==0.and.(.not.results_gathered)) then
463 : call gather_results_out(dtsets,mpi_enregs,results_out,results_out_all,use_results_all, &
464 0 : & allgather=.true.,only_one_per_img=.true.)
465 0 : results_gathered=.true.
466 : end if
467 0 : if ((.not.test_img).or.mpi_enregs(idtset)%me_cell==0) then
468 28 : do iimage=1,nimage
469 14 : ii=mpi_enregs(idtset)%my_imgtab(iimage)
470 56 : acell_img(:,iimage)=zero
471 182 : rprim_img(:,:,iimage)=zero
472 42 : do iimage_get=1,dtsets(iget_cell)%nimage
473 56 : do jj=1,3
474 : acell_img(jj,iimage)=acell_img(jj,iimage)+&
475 42 : & miximage(ii,iimage_get)*results_out_all(iget_cell)%acell(jj,iimage_get)
476 182 : do kk=1,3
477 : rprim_img(kk,jj,iimage)=rprim_img(kk,jj,iimage)+&
478 168 : & miximage(ii,iimage_get)*results_out_all(iget_cell)%rprim(kk,jj,iimage_get)
479 : end do
480 : end do
481 182 : dtset%rprimd_orig(:,:,iimage)=dtsets(iget_cell)%rprimd_orig(:,:,iimage)
482 : ! Check that the new acell and rprim are consistent with the input dilatmx
483 14 : call mkrdim(acell_img(:,iimage),rprim_img(:,:,iimage),rprimd)
484 : call chkdilatmx(dtset%chkdilatmx,dtset%dilatmx,rprimd,&
485 14 : & dtset%rprimd_orig(1:3,1:3,iimage), dilatmx_errmsg)
486 28 : if (LEN_TRIM(dilatmx_errmsg) /= 0) then
487 0 : acell_img(1,iimage) = sqrt(sum(rprimd(:,1)**2))
488 0 : acell_img(2,iimage) = sqrt(sum(rprimd(:,2)**2))
489 0 : acell_img(3,iimage) = sqrt(sum(rprimd(:,3)**2))
490 0 : rprim_img(:,1,iimage) = rprimd(:,1) / acell_img(1,iimage)
491 0 : rprim_img(:,2,iimage) = rprimd(:,2) / acell_img(1,iimage)
492 0 : rprim_img(:,3,iimage) = rprimd(:,3) / acell_img(1,iimage)
493 0 : ABI_WARNING(dilatmx_errmsg)
494 : end if
495 : end do
496 : end do
497 : end if
498 : end if
499 :
500 3890 : call find_getdtset(dtsets,dtset%getxred,'getxred',idtset,iget_xred,miximage,mxnimage,ndtset_alloc)
501 3890 : if(iget_xred/=0)then
502 : ! Gather contributions to results_out from images, if needed
503 20 : if (test_img.and.mpi_enregs(idtset)%me_cell==0.and.(.not.results_gathered)) then
504 : call gather_results_out(dtsets,mpi_enregs,results_out,results_out_all,use_results_all, &
505 0 : & allgather=.true.,only_one_per_img=.true.)
506 0 : results_gathered=.true.
507 : end if
508 0 : if ((.not.test_img).or.mpi_enregs(idtset)%me_cell==0) then
509 50 : do iimage=1,nimage
510 30 : ii=mpi_enregs(idtset)%my_imgtab(iimage)
511 270 : xred_img(:,:,iimage)=zero
512 135 : do iimage_get=1,dtsets(iget_xred)%nimage
513 285 : do jj=1,dtset%natom
514 765 : do kk=1,3
515 : xred_img(kk,jj,iimage)=xred_img(kk,jj,iimage)+&
516 680 : & miximage(ii,iimage_get)*results_out_all(iget_xred)%xred(kk,jj,iimage_get)
517 : end do
518 : end do
519 : end do
520 : end do
521 : end if
522 : end if
523 :
524 3890 : call find_getdtset(dtsets,dtset%getxcart,'getxcart',idtset,iget_xcart,miximage,mxnimage,ndtset_alloc)
525 3890 : if(iget_xcart/=0)then
526 : ! Gather contributions to results_out from images, if needed
527 24 : if (test_img.and.mpi_enregs(idtset)%me_cell==0.and.(.not.results_gathered)) then
528 : call gather_results_out(dtsets,mpi_enregs,results_out,results_out_all,use_results_all, &
529 0 : & allgather=.true.,only_one_per_img=.true.)
530 0 : results_gathered=.true.
531 : end if
532 0 : if ((.not.test_img).or.mpi_enregs(idtset)%me_cell==0) then
533 72 : ABI_MALLOC(xcart,(3,dtset%natom))
534 48 : ABI_MALLOC(xredget,(3,dtset%natom))
535 48 : do iimage=1,nimage
536 24 : ii=mpi_enregs(idtset)%my_imgtab(iimage)
537 216 : xred_img(:,:,iimage)=zero
538 72 : do iimage_get=1,dtsets(iget_xcart)%nimage
539 : ! Compute xcart of the previous dataset
540 : call mkrdim(results_out_all(iget_xcart)%acell(:,iimage_get),&
541 24 : & results_out_all(iget_xcart)%rprim(:,:,iimage_get),rprimd)
542 72 : do jj=1,dtset%natom
543 216 : do kk=1,3
544 192 : xredget (kk,jj)=results_out_all(iget_xcart)%xred(kk,jj,iimage_get)
545 : end do
546 : end do
547 24 : call xred2xcart(dtset%natom,rprimd,xcart,xredget)
548 : ! xcart from previous dataset is computed. Now, produce xred for the new dataset,
549 : ! with the new acell and rprim ...
550 24 : call mkrdim(acell_img(:,iimage),rprim_img(:,:,iimage),rprimd)
551 24 : call xcart2xred(dtset%natom,rprimd,xcart,xredget(:,:))
552 96 : do jj=1,dtset%natom
553 216 : do kk=1,3
554 192 : xred_img(kk,jj,iimage)=xred_img(kk,jj,iimage)+miximage(ii,iimage_get)*xredget(kk,jj)
555 : end do
556 : end do
557 : end do
558 : end do
559 24 : ABI_FREE(xcart)
560 24 : ABI_FREE(xredget)
561 : end if
562 : end if
563 :
564 3890 : call find_getdtset(dtsets,dtset%getvel,'getvel',idtset,iget_vel,miximage,mxnimage,ndtset_alloc)
565 3890 : if(iget_vel/=0)then
566 : ! Gather contributions to results_out from images, if needed
567 0 : if (test_img.and.mpi_enregs(idtset)%me_cell==0.and.(.not.results_gathered)) then
568 : call gather_results_out(dtsets,mpi_enregs,results_out,results_out_all,use_results_all, &
569 0 : & allgather=.true.,only_one_per_img=.true.)
570 0 : results_gathered=.true.
571 : end if
572 0 : if ((.not.test_img).or.mpi_enregs(idtset)%me_cell==0) then
573 0 : do iimage=1,nimage
574 0 : ii=mpi_enregs(idtset)%my_imgtab(iimage)
575 0 : vel_img(:,:,iimage)=zero
576 0 : vel_cell_img(:,:,iimage)=zero
577 0 : do iimage_get=1,dtsets(iget_vel)%nimage
578 0 : do jj=1,dtset%natom
579 0 : do kk=1,3
580 : vel_img(kk,jj,iimage)=vel_img(kk,jj,iimage)+&
581 0 : & miximage(ii,iimage_get)*results_out_all(iget_vel)%vel(kk,jj,iimage_get)
582 : vel_cell_img(kk,jj,iimage)=vel_cell_img(kk,jj,iimage)+&
583 0 : & miximage(ii,iimage_get)*results_out_all(iget_vel)%vel_cell(kk,jj,iimage_get)
584 : end do
585 : end do
586 : end do
587 : end do
588 : end if
589 : end if
590 :
591 : ! In the case of parallelization over images, has to distribute data
592 3890 : if (test_img) then
593 0 : if (iget_occ/=0) then
594 0 : call xmpi_bcast(occ_img,0,mpi_enregs(idtset)%comm_cell,ierr)
595 : end if
596 0 : if (iget_cell/=0) then
597 0 : call xmpi_bcast(acell_img,0,mpi_enregs(idtset)%comm_cell,ierr)
598 0 : call xmpi_bcast(rprim_img,0,mpi_enregs(idtset)%comm_cell,ierr)
599 : end if
600 0 : if (iget_vel/=0) then
601 0 : call xmpi_bcast(vel_img,0,mpi_enregs(idtset)%comm_cell,ierr)
602 0 : call xmpi_bcast(vel_cell_img,0,mpi_enregs(idtset)%comm_cell,ierr)
603 : end if
604 0 : if (iget_xred/=0.or.iget_xcart/=0) then
605 0 : call xmpi_bcast(xred_img,0,mpi_enregs(idtset)%comm_cell,ierr)
606 : end if
607 : end if
608 :
609 : ! Clean memory
610 3890 : ABI_FREE(miximage)
611 3890 : if (test_img.and.mpi_enregs(idtset)%me_cell==0) then
612 0 : if (results_gathered) then
613 0 : call destroy_results_out(results_out_all)
614 : end if
615 0 : ABI_FREE(results_out_all)
616 : else
617 3890 : nullify(results_out_all)
618 : end if
619 :
620 : end if
621 :
622 : ! ****************************************************************************
623 : ! Treat the pseudopotentials: initialize the psps/PAW variable
624 :
625 5281 : call psps_init_from_dtset(psps, dtset, idtset, pspheads)
626 :
627 : ! The correct dimension of pawrad/tab is ntypat. In case of alchemical psps
628 : ! pawrad/tab(ipsp) is invoked with ipsp<=npsp. So, in order to avoid any problem,
629 : ! declare pawrad/tab at paw_size=max(ntypat,npsp).
630 5281 : paw_size=0;if (psps%usepaw==1) paw_size=max(dtset%ntypat,dtset%npsp)
631 5281 : if (paw_size/=paw_size_old) then
632 1391 : if (paw_size_old/=-1) then
633 0 : call pawrad_free(pawrad)
634 0 : call pawtab_free(pawtab)
635 0 : ABI_FREE(pawrad)
636 0 : ABI_FREE(pawtab)
637 : end if
638 4737 : ABI_MALLOC(pawrad,(paw_size))
639 4737 : ABI_MALLOC(pawtab,(paw_size))
640 1391 : call pawtab_nullify(pawtab)
641 1391 : paw_size_old=paw_size
642 : end if
643 :
644 : ! ****************************************************************************
645 : ! WVL allocations.
646 :
647 : ! Nullify wvl_data. It is important to do so irregardless of the value of usewvl:
648 5281 : call nullify_wvl_data(wvl)
649 :
650 : ! Set up mpi information from the dataset
651 : if (dtset%usewvl == 1) then
652 : #if defined HAVE_BIGDFT
653 : call f_malloc_set_status(iproc=mpi_enregs(idtset)%me_wvl)
654 : call mpi_environment_set(bigdft_mpi,mpi_enregs(idtset)%me_wvl,&
655 : & mpi_enregs(idtset)%nproc_wvl,mpi_enregs(idtset)%comm_wvl,&
656 : & mpi_enregs(idtset)%nproc_wvl)
657 : #endif
658 : end if
659 :
660 : ! ****************************************************************************
661 : ! At this stage, all the data needed for the treatment of one dataset
662 : ! have been transferred from multi-dataset arrays.
663 :
664 5281 : iexit=0
665 :
666 : ! Smaller integer arrays
667 5281 : etotal=zero
668 15843 : ABI_MALLOC(npwtot,(dtset%nkpt))
669 116739 : npwtot = 0
670 15843 : ABI_MALLOC(xred,(3,dtset%natom))
671 15843 : ABI_MALLOC(occ,(dtset%mband*dtset%nkpt*dtset%nsppol))
672 5281 : if(dtset%optdriver/=RUNL_GSTATE)then
673 472762 : occ(:)=occ_img(:,1)
674 5256 : acell(:)=acell_img(:,1)
675 17082 : rprim(:,:)=rprim_img(:,:,1)
676 13002 : xred(:,:)=xred_img(:,:,1)
677 : end if
678 :
679 : ! ****************************************************************************
680 : ! Exchange-correlation
681 :
682 5281 : call echo_xc_name(dtset%ixc)
683 5281 : if (dtset%ixc<0) then
684 1151 : el_temp=merge(dtset%tphysel,dtset%tsmear,dtset%tphysel>tol8.and.dtset%occopt/=3.and.dtset%occopt/=9)
685 1151 : call libxc_functionals_init(dtset%ixc,dtset%nspden,el_temp=el_temp,xc_tb09_c=dtset%xc_tb09_c)
686 :
687 : #if defined DEV_YP_VDWXC
688 : if ( (dtset%vdw_xc > 0) .and. (dtset%vdw_xc < 3) ) then
689 : vdw_params%functional = dtset%vdw_xc
690 : vdw_params%acutmin = dtset%vdw_df_acutmin
691 : vdw_params%aratio = dtset%vdw_df_aratio
692 : vdw_params%damax = dtset%vdw_df_damax
693 : vdw_params%damin = dtset%vdw_df_damin
694 : vdw_params%dcut = dtset%vdw_df_dcut
695 : vdw_params%dratio = dtset%vdw_df_dratio
696 : vdw_params%dsoft = dtset%vdw_df_dsoft
697 : vdw_params%gcut = dtset%vdw_df_gcut
698 : vdw_params%ndpts = dtset%vdw_df_ndpts
699 : vdw_params%ngpts = dtset%vdw_df_ngpts
700 : vdw_params%nqpts = dtset%vdw_df_nqpts
701 : vdw_params%nrpts = dtset%vdw_df_nrpts
702 : vdw_params%nsmooth = dtset%vdw_df_nsmooth
703 : vdw_params%phisoft = dtset%vdw_df_phisoft
704 : vdw_params%qcut = dtset%vdw_df_qcut
705 : vdw_params%qratio = dtset%vdw_df_qratio
706 : vdw_params%rcut = dtset%vdw_df_rcut
707 : vdw_params%rsoft = dtset%vdw_df_rsoft
708 : vdw_params%tolerance = dtset%vdw_df_tolerance
709 : vdw_params%tweaks = dtset%vdw_df_tweaks
710 : vdw_params%zab = dtset%vdw_df_zab
711 : write(msg,'(a,1x,a)') ch10,'[vdW-DF] *** Before init ***'
712 : call wrtout(std_out,msg)
713 : call xc_vdw_show(std_out,vdw_params)
714 : if ( dtset%irdvdw == 1 ) then
715 : write(vdw_filnam,'(a,a)') trim(filnam(3)),'_VDW.nc'
716 : call xc_vdw_read(vdw_filnam)
717 : else
718 : call xc_vdw_init(vdw_params)
719 : end if
720 : call xc_vdw_libxc_init(vdw_params%functional)
721 : write(msg,'(a,1x,a)') ch10,'[vdW-DF] *** After init ***'
722 : call wrtout(std_out,msg)
723 : ! call xc_vdw_get_params(vdw_params)
724 : call xc_vdw_memcheck(std_out)
725 : call xc_vdw_show(std_out)
726 : call xc_vdw_show(ab_out)
727 :
728 : write (msg,'(a,1x,a,e10.3,a)')ch10,&
729 : & '[vdW-DF] activation threshold: vdw_df_threshold=',dtset%vdw_df_threshold,ch10
730 : call xc_vdw_trigger(.false.)
731 : call wrtout(std_out,msg)
732 : end if
733 : #else
734 1151 : if ( (dtset%vdw_xc > 0) .and. (dtset%vdw_xc < 3) ) then
735 : write(msg,'(3a)')&
736 0 : & 'vdW-DF functionals are not fully operational yet.',ch10,&
737 0 : & 'Action: modify vdw_xc'
738 0 : ABI_ERROR(msg)
739 : end if
740 : #endif
741 : end if
742 :
743 : ! FFTW3 threads initialization
744 5281 : if (dtset%ngfft(7) / 100 == FFT_FFTW3) call fftw3_init_threads()
745 :
746 : ! Activate mixed-precision for FFT libs.
747 5281 : ii = fftcore_set_mixprec(dtset%mixprec)
748 :
749 : ! linalg initialisation
750 173063 : linalg_max_size=maxval(dtset%nband(:))
751 : call abi_linalg_init(linalg_max_size,dtset%optdriver,dtset%wfoptalg,dtset%paral_kgb,&
752 5281 : dtset%gpu_option,dtset%use_slk,dtset%np_slk,mpi_enregs(idtset)%comm_bandspinorfft)
753 :
754 5281 : call timab(642,2,tsec)
755 5281 : call pstat_proc%print(_PSTAT_ARGS_)
756 :
757 : ! ****************************************************************************
758 : ! Main case selection in driver
759 :
760 9248 : select case(dtset%optdriver)
761 :
762 : case (RUNL_GSTATE)
763 :
764 15868 : ABI_MALLOC(fcart_img,(3,dtset%natom,nimage))
765 15868 : ABI_MALLOC(gred_img,(3,dtset%natom,nimage))
766 19835 : ABI_MALLOC(intgres_img,(dtset%nspden,dtset%natom,nimage))
767 11901 : ABI_MALLOC(etotal_img,(nimage))
768 11901 : ABI_MALLOC(strten_img,(6,nimage))
769 :
770 : call gstateimg(acell_img,amu_img,codvsn,cpui,dtfil,dtset,etotal_img,fcart_img,&
771 : gred_img,iexit,intgres_img,mixalch_img,mpi_enregs(idtset),nimage,npwtot,occ_img,&
772 : pawang,pawrad,pawtab,psps,rprim_img,strten_img,vel_cell_img,vel_img,wvl,xred_img,&
773 3967 : filnam,filstat,idtset,jdtset_,ndtset)
774 :
775 : case (RUNL_RESPFN)
776 : call respfn(codvsn,cpui,dtfil,dtset,etotal,iexit,mkmems,mpi_enregs(idtset),&
777 716 : npwtot,occ,pawang,pawrad,pawtab,psps,results_respfn,xred)
778 :
779 : case (RUNL_SCREENING)
780 148 : call screening(acell,codvsn,dtfil,dtset,pawang,pawrad,pawtab,psps,rprim)
781 :
782 : case (RUNL_SIGMA)
783 201 : call sigma(acell,codvsn,dtfil,dtset,pawang,pawrad,pawtab,psps,rprim)
784 :
785 : case (RUNL_NONLINEAR)
786 28 : call nonlinear(codvsn,dtfil,dtset,etotal,mpi_enregs(idtset),npwtot,occ,pawang,pawrad,pawtab,psps,xred)
787 :
788 : case (RUNL_GWR)
789 0 : call gwr_driver(codvsn, dtfil, dtset, pawang, pawrad, pawtab, psps, xred)
790 :
791 : case (RUNL_BSE)
792 29 : call bethe_salpeter(acell,codvsn,dtfil,dtset,pawang,pawrad,pawtab,psps,rprim,xred)
793 :
794 : case (RUNL_GWLS)
795 : ! For running G0W0 calculations with Lanczos basis for dielectric operator
796 : ! and Sternheimer equation for avoiding the use of conduction states (MC+JJL)
797 24 : ABI_MALLOC(etotal_img,(nimage))
798 32 : ABI_MALLOC(fcart_img,(3,dtset%natom,nimage))
799 24 : ABI_MALLOC(gred_img,(3,dtset%natom,nimage))
800 40 : ABI_MALLOC(intgres_img,(dtset%nspden,dtset%natom,nimage))
801 24 : ABI_MALLOC(strten_img,(6,nimage))
802 :
803 : call gwls_sternheimer(acell_img,amu_img,codvsn,cpui,dtfil,dtset,etotal_img,fcart_img,&
804 : gred_img,iexit,intgres_img,mixalch_img,mpi_enregs(idtset),nimage,npwtot,occ_img,&
805 : pawang,pawrad,pawtab,psps,rprim_img,strten_img,vel_cell_img,vel_img,xred_img,&
806 8 : filnam,filstat,idtset,jdtset_,ndtset)
807 :
808 8 : ABI_FREE(etotal_img)
809 8 : ABI_FREE(fcart_img)
810 8 : ABI_FREE(gred_img)
811 8 : ABI_FREE(intgres_img)
812 8 : ABI_FREE(strten_img)
813 :
814 : case (RUNL_WFK)
815 12 : call wfk_analyze(acell,codvsn,dtfil,dtset,pawang,pawrad,pawtab,psps,rprim,xred)
816 :
817 : case (RUNL_EPH)
818 109 : call dtsets(0)%free_nkpt_arrays()
819 109 : call dtsets(idtset)%free_nkpt_arrays()
820 109 : call eph(acell,codvsn,dtfil,dtset,pawang,pawrad,pawtab,psps,rprim,xred)
821 :
822 : case (RUNL_LONGWAVE)
823 :
824 : call longwave(codvsn,dtfil,dtset,etotal,mpi_enregs(idtset),npwtot,occ,&
825 17 : & pawrad,pawtab,psps,xred)
826 :
827 : case (RUNL_RTTDDFT)
828 46 : call rttddft(codvsn,dtfil,dtset,mpi_enregs(idtset),pawang,pawrad,pawtab,psps)
829 :
830 : case default
831 : write(msg,'(a,i0,4a)')&
832 0 : 'Unknown value for the variable optdriver: ',dtset%optdriver,ch10,&
833 0 : 'This is not allowed.',ch10, 'Action: modify optdriver in the input file.'
834 5281 : ABI_ERROR(msg)
835 : end select
836 :
837 5281 : call timab(643,1,tsec)
838 : ! ****************************************************************************
839 :
840 : ! Transfer of multi dataset outputs from temporaries:
841 : ! acell, xred, occ rprim, and vel might be modified from their input values
842 : ! etotal, fcart, gred, intgres, and strten have been computed
843 : ! npwtot was already computed before, but is stored only now
844 :
845 5281 : if(dtset%optdriver==RUNL_GSTATE)then
846 8194 : do iimage=1,nimage
847 4227 : results_out(idtset)%etotal(iimage) =etotal_img(iimage)
848 16908 : results_out(idtset)%acell(:,iimage) =acell_img(:,iimage)
849 9765 : results_out(idtset)%amu(1:dtset%ntypat,iimage) =amu_img(:,iimage)
850 54951 : results_out(idtset)%rprim(:,:,iimage) =rprim_img(:,:,iimage)
851 29589 : results_out(idtset)%strten(:,iimage) =strten_img(:,iimage)
852 44435 : results_out(idtset)%fcart(1:3,1:dtset%natom,iimage)=fcart_img(:,:,iimage)
853 44435 : results_out(idtset)%gred(1:3,1:dtset%natom,iimage) =gred_img(:,:,iimage)
854 4227 : if(dtset%nspden/=2)then
855 22996 : results_out(idtset)%intgres(1:dtset%nspden,1:dtset%natom,iimage) =intgres_img(:,:,iimage)
856 : else
857 1439 : results_out(idtset)%intgres(1,1:dtset%natom,iimage) =intgres_img(1,:,iimage)
858 1439 : results_out(idtset)%intgres(4,1:dtset%natom,iimage) =intgres_img(2,:,iimage)
859 : endif
860 : results_out(idtset)%mixalch(1:dtset%npspalch,1:dtset%ntypalch,iimage) &
861 4302 : & =mixalch_img(1:dtset%npspalch,1:dtset%ntypalch,iimage)
862 52638 : results_out(idtset)%npwtot(1:dtset%nkpt,iimage) =npwtot(1:dtset%nkpt)
863 : results_out(idtset)%occ(1:dtset%mband*dtset%nkpt*dtset%nsppol,iimage)=&
864 424182 : & occ_img(1:dtset%mband*dtset%nkpt*dtset%nsppol,iimage)
865 44435 : results_out(idtset)%vel(:,1:dtset%natom,iimage) =vel_img(:,:,iimage)
866 54951 : results_out(idtset)%vel_cell(:,:,iimage) =vel_cell_img(:,:,iimage)
867 48402 : results_out(idtset)%xred(:,1:dtset%natom,iimage) =xred_img(:,:,iimage)
868 : end do
869 3967 : ABI_FREE(etotal_img)
870 3967 : ABI_FREE(fcart_img)
871 3967 : ABI_FREE(gred_img)
872 3967 : ABI_FREE(intgres_img)
873 3967 : ABI_FREE(strten_img)
874 : else
875 5256 : results_out(idtset)%acell(:,1) =acell(:)
876 1314 : results_out(idtset)%etotal(1) =etotal
877 17082 : results_out(idtset)%rprim(:,:,1) =rprim(:,:)
878 68156 : results_out(idtset)%npwtot(1:dtset%nkpt,1) =npwtot(1:dtset%nkpt)
879 : results_out(idtset)%occ(1:dtset%mband*dtset%nkpt*dtset%nsppol,1)=&
880 472762 : & occ(1:dtset%mband*dtset%nkpt*dtset%nsppol)
881 13002 : results_out(idtset)%xred(:,1:dtset%natom,1) =xred(:,:)
882 : end if
883 5281 : ABI_FREE(acell_img)
884 5281 : ABI_FREE(amu_img)
885 5281 : ABI_FREE(mixalch_img)
886 5281 : ABI_FREE(occ_img)
887 5281 : ABI_FREE(rprim_img)
888 5281 : ABI_FREE(vel_img)
889 5281 : ABI_FREE(vel_cell_img)
890 5281 : ABI_FREE(xred_img)
891 :
892 5281 : if (dtset%ngfft(7) / 100 == FFT_FFTW3) call fftw3_cleanup()
893 :
894 5281 : if (dtset%ixc<0) then
895 1151 : call libxc_functionals_end()
896 :
897 : #if defined DEV_YP_VDWXC
898 : if ( (dtset%vdw_xc > 0) .and. (dtset%vdw_xc < 10) ) then
899 : if ( dtset%prtvdw /= 0 ) then
900 : write(vdw_filnam,'(a,a)') trim(filnam(4)),'_VDW.nc'
901 : call xc_vdw_write(vdw_filnam)
902 : end if
903 : call xc_vdw_show(std_out,vdw_params)
904 : call xc_vdw_done(vdw_params)
905 : end if
906 : #endif
907 : end if
908 :
909 : ! MG: There are routines such as GW and Berry phase that can change/compute
910 : ! entries in the datatype at run-time. These changes won't be visibile
911 : ! in the main output file since we are passing a copy of dtsets.
912 : ! I tried to update the results with the call below but this creates
913 : ! several problems in outvars since one should take into account
914 : ! the new dimensions (e.g. nkptgw) and their maximum value.
915 : ! For the time being, we continue to pass a copy of dtsets(idtset).
916 : !call dtsets(idtset)%free()
917 : !call dtsets(idtset) = dtset%copy()
918 :
919 5281 : call dtset%free()
920 :
921 5281 : ABI_FREE(occ)
922 5281 : ABI_FREE(xred)
923 5281 : ABI_FREE(npwtot)
924 :
925 5281 : call abi_linalg_finalize(dtset%gpu_option)
926 5281 : call xg_finalize()
927 :
928 5281 : call cwtime_report(sjoin(" dataset:", itoa(idtset)), cpu, wall, gflops)
929 5281 : call timab(643,2,tsec)
930 :
931 : ! Check whether exiting was required by the user.
932 : ! If found then beat a hasty exit from time steps
933 5281 : openexit=1; if(dtset%chkexit==0) openexit=0
934 5281 : call exit_check(zero,dtfil%filnam_ds(1),iexit,ab_out,mpi_enregs(idtset)%comm_cell,openexit)
935 :
936 11953 : if (iexit/=0) exit
937 : end do ! idtset (allocate statements are present - an exit statement is present)
938 :
939 : !*********************************************************************
940 :
941 1391 : call timab(644,1,tsec)
942 :
943 : #ifdef HAVE_LINALG_ELPA
944 : call elpa_func_uninit()
945 : #endif
946 :
947 1391 : call psps_free(psps)
948 :
949 : !XG 121126 : One should not use dtset or idtset in this section, as these might not be defined for all processors.
950 :
951 : !PAW deallocation
952 1391 : if (allocated(pawrad)) then
953 1391 : call pawrad_free(pawrad)
954 1955 : ABI_FREE(pawrad)
955 : end if
956 1391 : if (allocated(pawtab)) then
957 1391 : call pawtab_free(pawtab)
958 1955 : ABI_FREE(pawtab)
959 : end if
960 1391 : call pawang_free(pawang)
961 :
962 1391 : ABI_FREE(jdtset_)
963 :
964 1391 : call results_respfn%free()
965 :
966 1391 : call timab(644,2,tsec)
967 1391 : call timab(640,2,tsec)
968 :
969 : DBG_EXIT("COLL")
970 :
971 2782 : end subroutine driver
972 : !!***
973 :
974 : end module m_driver
975 : !!***
|
