Branch data 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 : 1410 : subroutine driver(codvsn,cpui,dtsets,filnam,filstat,&
146 : 1410 : & 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 [ + + + + : 180480 : type(dataset_type) :: dtset
+ + + + +
+ + + + +
+ + + + +
+ + + + +
+ + + + +
+ + + + +
+ + + + +
+ + + + +
+ + + + +
+ + + + +
+ + + + +
+ + + + +
+ + + + +
+ + + + +
+ + + + +
+ + + +
+ ]
175 : : type(datafiles_type) :: dtfil
176 : 1410 : type(pawang_type) :: pawang
177 : 1410 : type(pseudopotential_type) :: psps
178 : 1410 : type(results_respfn_type) :: results_respfn
179 : 1410 : 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 : 1410 : integer,allocatable :: jdtset_(:),npwtot(:)
187 : : real(dp) :: acell(3),rprim(3,3),rprimd(3,3),tsec(2)
188 : 1410 : real(dp),allocatable :: acell_img(:,:),amu_img(:,:),rprim_img(:,:,:)
189 : 1410 : real(dp),allocatable :: fcart_img(:,:,:),gred_img(:,:,:),intgres_img(:,:,:)
190 : 1410 : real(dp),allocatable :: etotal_img(:),mixalch_img(:,:,:),strten_img(:,:),miximage(:,:)
191 : 1410 : real(dp),allocatable :: occ(:),xcart(:,:),xred(:,:),xredget(:,:)
192 : 1410 : real(dp),allocatable :: occ_img(:,:),vel_cell_img(:,:,:),vel_img(:,:,:),xred_img(:,:,:)
193 : 1410 : type(pawrad_type),allocatable :: pawrad(:)
194 : 1410 : type(pawtab_type),allocatable :: pawtab(:)
195 : 1410 : type(results_out_type),pointer :: results_out_all(:)
196 : :
197 : : !******************************************************************
198 : :
199 : : DBG_ENTER("COLL")
200 : :
201 : 1410 : call timab(640,1,tsec)
202 : 1410 : call timab(641,3,tsec)
203 : :
204 : : !Structured debugging if prtvol==-level
205 : 1410 : prtvol=dtsets(1)%prtvol
206 [ - + ]: 1410 : 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 [ - + ]: 1410 : 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 : 1410 : mtypalch=dtsets(1)%ntypalch
217 [ + + ]: 6750 : do ii=1,ndtset_alloc
218 : 6750 : mtypalch=max(dtsets(ii)%ntypalch,mtypalch)
219 : : end do
220 : 1410 : call psps_init_global(psps, mtypalch, npsp, pspheads)
221 : :
222 [ - + + - : 4230 : ABI_MALLOC(jdtset_,(0:ndtset))
+ - + - -
+ - + ]
223 [ + + ]: 1410 : if(ndtset/=0)then
224 [ + + ]: 6972 : jdtset_(:)=dtsets(0:ndtset)%jdtset
225 : : else
226 : 396 : jdtset_(0)=0
227 : : end if
228 : :
229 [ + + ]: 6750 : do idtset=1,ndtset_alloc
230 : 6750 : call results_respfn%init(dtsets,ndtset_alloc)
231 : : end do
232 : :
233 : 1410 : 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 [ + + ]: 6749 : do idtset=1,ndtset_alloc
242 : :
243 [ + - ]: 5340 : if(mpi_enregs(idtset)%me<0) cycle
244 : :
245 : 5340 : call cwtime(cpu, wall, gflops, "start")
246 : 5340 : call timab(642,1,tsec)
247 : 5340 : call abi_io_redirect(new_io_comm=mpi_enregs(idtset)%comm_world)
248 : 5340 : call libpaw_write_comm_set(mpi_enregs(idtset)%comm_world)
249 : :
250 [ + + ]: 5340 : 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 [ - + - + : 5340 : dtset = dtsets(idtset)%copy()
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + ]
260 : :
261 : : ! Set other values
262 : 5340 : dtset%jdtset = jdtset
263 : 5340 : dtset%ndtset = ndtset
264 : :
265 : : ! Print DATASET number
266 [ + - + + ]: 432540 : write(msg,'(83a)') ch10,('=',mu=1,80),ch10,'== DATASET'
267 [ + + ]: 5340 : if (jdtset>=100) then
268 [ + - + + ]: 12090 : write(msg,'(2a,i4,65a)') trim(msg),' ',jdtset,' ',('=',mu=1,64)
269 : : else
270 [ + - + + ]: 345318 : 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 : 5340 : omp_nthreads = -1
277 : : #endif
278 : 5340 : write(msg,'(2a,2(a, i0), a)') trim(msg),ch10,&
279 : 10680 : '- mpi_nproc: ',mpi_enregs(idtset)%nproc, ", omp_nthreads: ", omp_nthreads, " (-1 if OMP is not activated)"
280 : :
281 [ + + ]: 5340 : if (dtset%optdriver == RUNL_GSTATE) then
282 [ + + ]: 4006 : 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 : 5340 : write(msg,'(3a)') trim(msg),ch10,' '
288 : 5340 : call wrtout(ab_out, msg)
289 : 5340 : call wrtout(std_out, msg, 'PERS') ! PERS is choosen to make debugging easier
290 : :
291 : 5340 : call yaml_iterstart('dtset', jdtset, ab_out, dtset%use_yaml)
292 : :
293 [ + + ]: 5340 : if (mpi_enregs(idtset)%me_cell == 0) then
294 : 4446 : 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 [ + + ]: 35568 : dict_key="dimensions")
301 : :
302 : : ! Write cutoff energies.
303 : : call ydoc%add_reals("ecut, pawecutdg", [dtset%ecut, dtset%pawecutdg], &
304 [ + + ]: 13338 : 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 [ + + ]: 22230 : 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 : 7750 : 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 [ + + ]: 19824 : 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 [ + + ]: 4368 : 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 [ + + ]: 48 : [dtset%optdriver, dtset%wfk_task] , dict_key="meta")
336 : :
337 : : case (RUNL_SCREENING, RUNL_SIGMA)
338 : : call ydoc%add_ints("optdriver, gwcalctyp", &
339 [ + + ]: 900 : [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 [ + + ]: 44 : call ydoc%add_ints("optdriver", [dtset%optdriver], dict_key="meta")
356 : :
357 : : case default
358 [ + + + + : 4446 : ABI_ERROR(sjoin('Add a meta section for optdriver: ', itoa(dtset%optdriver)))
+ + - + +
+ + - ]
359 : : end select
360 : :
361 : : !if (dtset%use_yaml == 1) then
362 : 4446 : 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 [ - + ]: 5340 : if ( dtset%np_slk == 0 ) then
369 : 0 : call xgScalapack_config(SLK_DISABLED,dtset%slk_rankpp)
370 [ + + ]: 5340 : else if ( dtset%np_slk == 1000000 ) then
371 : 5296 : 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 : 5340 : mkmems(1) = dtset%mkmem
380 : 5340 : mkmems(2) = dtset%mkqmem
381 : 5340 : mkmems(3) = dtset%mk1mem
382 : :
383 : : ! Initialize MPI data for the parallelism over images
384 : 5340 : nimage=mpi_enregs(idtset)%my_nimage
385 : :
386 : : ! Retrieve evolving arrays (most of them depend on images)
387 [ - + + - : 16020 : ABI_MALLOC(acell_img,(3,nimage))
+ - + - -
+ - + -
+ ]
388 [ - + + - : 21360 : ABI_MALLOC(amu_img,(dtset%ntypat,nimage))
- + + - +
- + - - +
- + ]
389 [ + + + - : 26700 : ABI_MALLOC(mixalch_img,(dtset%npspalch,dtset%ntypalch,nimage))
+ + + - -
+ + - + -
+ + - + -
+ ]
390 [ - + + - : 21360 : ABI_MALLOC(occ_img,(dtset%mband*dtset%nkpt*dtset%nsppol,nimage))
- + + - +
- + - - +
- + - + ]
391 [ - + + - : 16020 : ABI_MALLOC(rprim_img,(3,3,nimage))
+ - + - -
+ - + -
+ ]
392 [ - + + - : 21360 : ABI_MALLOC(vel_img,(3,dtset%natom,nimage))
- + + - +
- + - - +
- + - + ]
393 [ - + + - : 10680 : ABI_MALLOC(vel_cell_img,(3,3,nimage))
- + - + -
+ ]
394 [ - + + - : 16020 : ABI_MALLOC(xred_img,(3,dtset%natom,nimage))
- + + - -
+ - + -
+ ]
395 [ + + ]: 10940 : do iimage=1,nimage
396 : 5600 : ii=mpi_enregs(idtset)%my_imgtab(iimage)
397 [ + + ]: 22400 : acell_img (: ,iimage) = dtset%acell_orig(:,ii)
398 [ + + ]: 13060 : amu_img (: ,iimage) = dtset%amu_orig(1:dtset%ntypat,ii)
399 [ + + + + ]: 5678 : mixalch_img (:,:,iimage) =dtset%mixalch_orig(1:dtset%npspalch,1:dtset%ntypalch,ii)
400 [ + + + + ]: 72800 : rprim_img (:,:,iimage) = dtset%rprim_orig(:,:,ii)
401 [ + + + + ]: 57960 : vel_img (:,:,iimage) = dtset%vel_orig(:,1:dtset%natom,ii)
402 [ + + + + ]: 72800 : vel_cell_img(:,:,iimage) = dtset%vel_cell_orig(:,:,ii)
403 [ + + + + ]: 57960 : xred_img (:,:,iimage) = dtset%xred_orig(:,1:dtset%natom,ii)
404 [ + + ]: 915338 : 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 : 5340 : call dtfil%init(dtset,filnam,filstat,idtset,jdtset_,mpi_enregs(idtset),ndtset)
412 [ + + + + ]: 5340 : 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 [ + + + + ]: 5340 : if( ndtset>1 .and. idtset>1 )then
422 : :
423 : : ! Check if parallelization over images is activated
424 [ + + ]: 86232 : mxnimage=maxval(dtsets(1:ndtset_alloc)%nimage)
425 [ - + + - : 15720 : ABI_MALLOC(miximage,(mxnimage,mxnimage))
- + + - +
- + - - +
- + ]
426 [ + + ]: 90162 : test_img=(mxnimage/=1.and.maxval(dtsets(:)%npimage)>1)
427 : 3930 : use_results_all=.false.
428 [ - + - - ]: 3930 : 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 : 3930 : results_out_all => results_out
433 : : end if
434 : 3930 : results_gathered=.false.
435 : :
436 : 3930 : call find_getdtset(dtsets,dtset%getocc,'getocc',idtset,iget_occ,miximage,mxnimage,ndtset_alloc)
437 [ + + ]: 3930 : 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 : 3930 : call find_getdtset(dtsets,dtset%getcell,'getcell',idtset,iget_cell,miximage,mxnimage,ndtset_alloc)
460 [ + + ]: 3930 : 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 : 3930 : call find_getdtset(dtsets,dtset%getxred,'getxred',idtset,iget_xred,miximage,mxnimage,ndtset_alloc)
501 [ + + ]: 3930 : 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 : 3930 : call find_getdtset(dtsets,dtset%getxcart,'getxcart',idtset,iget_xcart,miximage,mxnimage,ndtset_alloc)
525 [ + + ]: 3930 : 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 : 3930 : call find_getdtset(dtsets,dtset%getvel,'getvel',idtset,iget_vel,miximage,mxnimage,ndtset_alloc)
565 [ - + ]: 3930 : 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 [ - + ]: 3930 : 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 [ - + ]: 3930 : ABI_FREE(miximage)
611 [ - + - - ]: 3930 : 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 : 3930 : nullify(results_out_all)
618 : : end if
619 : :
620 : : end if
621 : :
622 : : ! ****************************************************************************
623 : : ! Treat the pseudopotentials: initialize the psps/PAW variable
624 : :
625 : 5340 : 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 [ + + ]: 5340 : paw_size=0;if (psps%usepaw==1) paw_size=max(dtset%ntypat,dtset%npsp)
631 [ + + ]: 5340 : if (paw_size/=paw_size_old) then
632 [ - + ]: 1410 : 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 [ + + + - : 4817 : ABI_MALLOC(pawrad,(paw_size))
+ - + + -
+ - + - +
+ + ]
639 [ + + + - : 4817 : ABI_MALLOC(pawtab,(paw_size))
+ - + + -
+ - + - +
+ + ]
640 : 1410 : call pawtab_nullify(pawtab)
641 : 1410 : 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 : 5340 : 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 : 5340 : iexit=0
665 : :
666 : : ! Smaller integer arrays
667 : 5340 : etotal=zero
668 [ - + + - : 16020 : ABI_MALLOC(npwtot,(dtset%nkpt))
+ - + - -
+ - + ]
669 [ + + ]: 117355 : npwtot = 0
670 [ - + + - : 16020 : ABI_MALLOC(xred,(3,dtset%natom))
+ - + - -
+ - + ]
671 [ - + + - : 16020 : ABI_MALLOC(occ,(dtset%mband*dtset%nkpt*dtset%nsppol))
+ - + - -
+ - + ]
672 [ + + ]: 5340 : if(dtset%optdriver/=RUNL_GSTATE)then
673 [ + + ]: 475114 : occ(:)=occ_img(:,1)
674 [ + + ]: 5336 : acell(:)=acell_img(:,1)
675 [ + + + + ]: 17342 : rprim(:,:)=rprim_img(:,:,1)
676 [ + + + + ]: 13174 : xred(:,:)=xred_img(:,:,1)
677 : : end if
678 : :
679 : : ! ****************************************************************************
680 : : ! Exchange-correlation
681 : :
682 : 5340 : call echo_xc_name(dtset%ixc)
683 [ + + ]: 5340 : if (dtset%ixc<0) then
684 [ + + - + : 1192 : el_temp=merge(dtset%tphysel,dtset%tsmear,dtset%tphysel>tol8.and.dtset%occopt/=3.and.dtset%occopt/=9)
- + ]
685 : 1192 : 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 [ - + ]: 1192 : 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 [ - + ]: 5340 : if (dtset%ngfft(7) / 100 == FFT_FFTW3) call fftw3_init_threads()
745 : :
746 : : ! Activate mixed-precision for FFT libs.
747 : 5340 : ii = fftcore_set_mixprec(dtset%mixprec)
748 : :
749 : : ! linalg initialisation
750 [ + + ]: 173898 : linalg_max_size=maxval(dtset%nband(:))
751 : : call abi_linalg_init(linalg_max_size,dtset%optdriver,dtset%wfoptalg,dtset%paral_kgb,&
752 : 5340 : dtset%gpu_option,dtset%use_slk,dtset%np_slk,mpi_enregs(idtset)%comm_bandspinorfft)
753 : :
754 : 5340 : call timab(642,2,tsec)
755 : 5340 : call pstat_proc%print(_PSTAT_ARGS_)
756 : :
757 : : ! ****************************************************************************
758 : : ! Main case selection in driver
759 : :
760 : 9346 : select case(dtset%optdriver)
761 : :
762 : : case (RUNL_GSTATE)
763 : :
764 [ - + + - : 16024 : ABI_MALLOC(fcart_img,(3,dtset%natom,nimage))
- + + - +
- + - - +
- + - + ]
765 [ - + + - : 16024 : ABI_MALLOC(gred_img,(3,dtset%natom,nimage))
- + + - +
- + - - +
- + - + ]
766 [ - + + - : 20030 : ABI_MALLOC(intgres_img,(dtset%nspden,dtset%natom,nimage))
- + + - -
+ + - + -
+ - - + -
+ - + ]
767 [ - + + - : 12018 : ABI_MALLOC(etotal_img,(nimage))
+ - + - -
+ - + -
+ ]
768 [ - + + - : 12018 : 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 : 4006 : filnam,filstat,idtset,jdtset_,ndtset)
774 : :
775 : : case (RUNL_RESPFN)
776 : : call respfn(codvsn,cpui,dtfil,dtset,etotal,iexit,mkmems,mpi_enregs(idtset),&
777 : 721 : npwtot,occ,pawang,pawrad,pawtab,psps,results_respfn,xred)
778 : :
779 : : case (RUNL_SCREENING)
780 : 150 : call screening(acell,codvsn,dtfil,dtset,pawang,pawrad,pawtab,psps,rprim)
781 : :
782 : : case (RUNL_SIGMA)
783 : 206 : 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 : 16 : 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 : 50 : 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 [ + + + + : 5340 : ABI_ERROR(msg)
+ - + + +
+ + + - ]
835 : : end select
836 : :
837 : 5339 : 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 [ + + ]: 5339 : if(dtset%optdriver==RUNL_GSTATE)then
846 [ + + ]: 8272 : do iimage=1,nimage
847 : 4266 : results_out(idtset)%etotal(iimage) =etotal_img(iimage)
848 [ + + ]: 17064 : results_out(idtset)%acell(:,iimage) =acell_img(:,iimage)
849 [ + + ]: 9870 : results_out(idtset)%amu(1:dtset%ntypat,iimage) =amu_img(:,iimage)
850 [ + + + + ]: 55458 : results_out(idtset)%rprim(:,:,iimage) =rprim_img(:,:,iimage)
851 [ + + ]: 29862 : results_out(idtset)%strten(:,iimage) =strten_img(:,iimage)
852 [ + + + + ]: 44786 : results_out(idtset)%fcart(1:3,1:dtset%natom,iimage)=fcart_img(:,:,iimage)
853 [ + + + + ]: 44786 : results_out(idtset)%gred(1:3,1:dtset%natom,iimage) =gred_img(:,:,iimage)
854 [ + + ]: 4266 : if(dtset%nspden/=2)then
855 [ + + + + ]: 23248 : results_out(idtset)%intgres(1:dtset%nspden,1:dtset%natom,iimage) =intgres_img(:,:,iimage)
856 : : else
857 [ + + ]: 1444 : results_out(idtset)%intgres(1,1:dtset%natom,iimage) =intgres_img(1,:,iimage)
858 [ + + ]: 1444 : 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 [ + + + + ]: 4341 : & =mixalch_img(1:dtset%npspalch,1:dtset%ntypalch,iimage)
862 [ + + ]: 53002 : 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 [ + + ]: 434884 : & occ_img(1:dtset%mband*dtset%nkpt*dtset%nsppol,iimage)
865 [ + + + + ]: 44786 : results_out(idtset)%vel(:,1:dtset%natom,iimage) =vel_img(:,:,iimage)
866 [ + + + + ]: 55458 : results_out(idtset)%vel_cell(:,:,iimage) =vel_cell_img(:,:,iimage)
867 [ + + + + ]: 48792 : results_out(idtset)%xred(:,1:dtset%natom,iimage) =xred_img(:,:,iimage)
868 : : end do
869 [ - + ]: 4006 : ABI_FREE(etotal_img)
870 [ - + ]: 4006 : ABI_FREE(fcart_img)
871 [ - + ]: 4006 : ABI_FREE(gred_img)
872 [ - + ]: 4006 : ABI_FREE(intgres_img)
873 [ - + ]: 4006 : ABI_FREE(strten_img)
874 : : else
875 [ + + ]: 5332 : results_out(idtset)%acell(:,1) =acell(:)
876 : 1333 : results_out(idtset)%etotal(1) =etotal
877 [ + + + + ]: 17329 : results_out(idtset)%rprim(:,:,1) =rprim(:,:)
878 [ + + ]: 68379 : 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 [ + + ]: 474889 : & occ(1:dtset%mband*dtset%nkpt*dtset%nsppol)
881 [ + + + + ]: 13165 : results_out(idtset)%xred(:,1:dtset%natom,1) =xred(:,:)
882 : : end if
883 [ - + ]: 5339 : ABI_FREE(acell_img)
884 [ - + ]: 5339 : ABI_FREE(amu_img)
885 [ - + ]: 5339 : ABI_FREE(mixalch_img)
886 [ - + ]: 5339 : ABI_FREE(occ_img)
887 [ - + ]: 5339 : ABI_FREE(rprim_img)
888 [ - + ]: 5339 : ABI_FREE(vel_img)
889 [ - + ]: 5339 : ABI_FREE(vel_cell_img)
890 [ - + ]: 5339 : ABI_FREE(xred_img)
891 : :
892 [ - + ]: 5339 : if (dtset%ngfft(7) / 100 == FFT_FFTW3) call fftw3_cleanup()
893 : :
894 [ + + ]: 5339 : if (dtset%ixc<0) then
895 : 1191 : 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 : 5339 : call dtset%free()
920 : :
921 [ - + ]: 5339 : ABI_FREE(occ)
922 [ - + ]: 5339 : ABI_FREE(xred)
923 [ - + ]: 5339 : ABI_FREE(npwtot)
924 : :
925 : 5339 : call abi_linalg_finalize(dtset%gpu_option)
926 : 5339 : call xg_finalize()
927 : :
928 : 5339 : call cwtime_report(sjoin(" dataset:", itoa(idtset)), cpu, wall, gflops)
929 : 5339 : 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 [ + + ]: 5339 : openexit=1; if(dtset%chkexit==0) openexit=0
934 : 5339 : call exit_check(zero,dtfil%filnam_ds(1),iexit,ab_out,mpi_enregs(idtset)%comm_cell,openexit)
935 : :
936 [ + - ]: 12088 : if (iexit/=0) exit
937 : : end do ! idtset (allocate statements are present - an exit statement is present)
938 : :
939 : : !*********************************************************************
940 : :
941 : 1409 : call timab(644,1,tsec)
942 : :
943 : : #ifdef HAVE_LINALG_ELPA
944 : : call elpa_func_uninit()
945 : : #endif
946 : :
947 : 1409 : 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 [ + - ]: 1409 : if (allocated(pawrad)) then
953 : 1409 : call pawrad_free(pawrad)
954 [ + - + + : 1995 : ABI_FREE(pawrad)
- + - + -
+ - + ]
955 : : end if
956 [ + - ]: 1409 : if (allocated(pawtab)) then
957 : 1409 : call pawtab_free(pawtab)
958 [ + - + + : 1995 : ABI_FREE(pawtab)
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + ]
959 : : end if
960 : 1409 : call pawang_free(pawang)
961 : :
962 [ - + ]: 1409 : ABI_FREE(jdtset_)
963 : :
964 : 1409 : call results_respfn%free()
965 : :
966 : 1409 : call timab(644,2,tsec)
967 : 1409 : call timab(640,2,tsec)
968 : :
969 : : DBG_EXIT("COLL")
970 : :
971 [ - + - + : 2819 : end subroutine driver
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- - - - -
- - - - -
- - - - -
- - - - -
- + - - -
- - - - -
- - - - -
- - - - -
- - - - -
- - - - -
- - - - -
- - - - -
- - - - -
- - - - -
- - - - -
- - - - -
- - - - -
- - - - -
- - - - -
- - - - -
- - - - -
- - - - -
- - - - -
- - - - -
- - - - -
- - - - -
- + - - -
- - - - -
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + -
+ ]
972 : : !!***
973 : :
974 : : end module m_driver
975 : : !!***
|
