Branch data Line data Source code
1 : : !!****p* ABINIT/mrgdv
2 : : !! NAME
3 : : !! mrgdv
4 : : !!
5 : : !! FUNCTION
6 : : !! This program merges DFPT potentials for different q-vectors and perturbations.
7 : : !!
8 : : !! COPYRIGHT
9 : : !! Copyright (C) 2004-2026 ABINIT group (MG)
10 : : !! This file is distributed under the terms of the
11 : : !! GNU General Public Licence, see ~abinit/COPYING
12 : : !! or http://www.gnu.org/copyleft/gpl.txt .
13 : : !! For the initials of contributors, see ~abinit/doc/developers/contributors.txt .
14 : : !!
15 : : !! NOTES
16 : : !! DVDB file format:
17 : : !! version (integer)
18 : : !! number of potentials (integer)
19 : : !! for each potential:
20 : : !! Abinit header with info on the perturbation and the FFT mesh
21 : : !! potential on the FFT mesh
22 : : !!
23 : : !! SOURCE
24 : :
25 : : #if defined HAVE_CONFIG_H
26 : : #include "config.h"
27 : : #endif
28 : :
29 : : #include "abi_common.h"
30 : :
31 : 34 : program mrgdv
32 : :
33 : 34 : use defs_basis
34 : : use m_xmpi
35 : : use m_errors
36 : : use m_abicore
37 : :
38 : : use m_build_info, only : abinit_version
39 : : use m_specialmsg, only : specialmsg_getcount, herald
40 : : use m_fstrings, only : sjoin, itoa, ltoa
41 : : use m_io_tools, only : file_exists, prompt
42 : : use m_argparse, only : get_arg, get_arg_list
43 : : use m_fftcore, only : ngfft_seq
44 : : use m_dvdb, only : dvdb_t, dvdb_merge_files, dvdb_test_v1complete, dvdb_test_ftinterp, dvdb_test_v1rsym, &
45 : : dvdb_test_symcheck, dvdb_test_symcheck_native
46 : :
47 : : implicit none
48 : :
49 : : !Local variables-------------------------------
50 : : !scalars
51 : : integer,parameter :: gpu_option0 = 0
52 : : integer :: ii, nargs, nfiles, comm, prtvol, my_rank, lenr, dvdb_add_lr, rspace_cell, symv1scf, npert_miss, abimem_level
53 : : integer :: isym, itimrev
54 : : real(dp) :: dvdb_qdamp, abimem_limit_mb
55 : : character(len=24) :: codename
56 : : character(len=500) :: command, arg, msg
57 : : character(len=fnlen) :: dvdb_filepath, dump_file, ddb_filepath
58 [ + + + + : 2788 : type(dvdb_t) :: dvdb
+ + + + +
+ + + + +
+ + + + +
+ + + +
+ ]
59 : : !arrays
60 : : integer :: ngqpt(3), coarse_ngqpt(3), ngfftf(18), qptopt, g0q(3)
61 : : real(dp) :: qpt_source(3), qpt_target(3)
62 : 34 : character(len=fnlen),allocatable :: v1files(:)
63 : : ! *************************************************************************
64 : :
65 : : ! Change communicator for I/O (mandatory!)
66 : 34 : call abi_io_redirect(new_io_comm=xmpi_world)
67 : :
68 : : ! Initialize MPI
69 : 34 : call xmpi_init()
70 : 34 : comm = xmpi_world
71 : 34 : my_rank = xmpi_comm_rank(comm)
72 : :
73 : : ! Initialize memory profiling if it is activated
74 : : ! if a full abimem.mocc report is desired, set the argument of abimem_init to "2" instead of "0"
75 : : ! note that abimem.mocc files can easily be multiple GB in size so don't use this option normally
76 [ - + ]: 34 : ABI_CHECK(get_arg("abimem-level", abimem_level, msg, default=0) == 0, msg)
77 [ - + ]: 34 : ABI_CHECK(get_arg("abimem-limit-mb", abimem_limit_mb, msg, default=20.0_dp) == 0, msg)
78 : : #ifdef HAVE_MEM_PROFILING
79 : : call abimem_init(abimem_level, limit_mb=abimem_limit_mb)
80 : : #endif
81 : :
82 : : ! write greating,read the file names, etc.
83 : 34 : codename='MRGDV'//repeat(' ',18)
84 : 34 : call herald(codename, abinit_version, std_out)
85 : :
86 [ - + ]: 34 : ABI_CHECK(xmpi_comm_size(comm) == 1, "Not programmed for parallel execution")
87 [ - + ]: 34 : ABI_CHECK(get_arg("prtvol", prtvol, msg, default=0) == 0, msg)
88 : :
89 : 34 : nargs = command_argument_count()
90 : :
91 [ + - ]: 34 : if (nargs == 0) then
92 : : ! We are reading from stdin
93 : : ! Prepend prompt with `-` to bypass bug in intel18-19
94 : 34 : call prompt("Enter name of output file:", dvdb_filepath)
95 : 34 : call prompt("Enter total number of DFPT POT files:", nfiles)
96 [ + - - + : 34 : ABI_MALLOC(v1files, (nfiles))
- + - + -
+ - + -
+ ]
97 [ + + ]: 592 : do ii=1,nfiles
98 : 592 : call prompt(sjoin("Enter name of POT file", itoa(ii), ":"), v1files(ii))
99 : : end do
100 : 34 : call dvdb_merge_files(nfiles, v1files, dvdb_filepath, prtvol)
101 [ - + ]: 68 : ABI_FREE(v1files)
102 : :
103 : : else
104 : : ! Command line options.
105 [ # # ]: 0 : do ii=1,command_argument_count()
106 : 0 : call get_command_argument(ii, arg)
107 [ # # ]: 0 : if (arg == "-v" .or. arg == "--version") then
108 : 0 : write(std_out,"(a)") trim(abinit_version); goto 100
109 : :
110 [ # # ]: 0 : else if (arg == "-h" .or. arg == "--help") then
111 : : ! Document the options.
112 : 0 : write(std_out,*)"-v, --version Show version number and exit."
113 : 0 : write(std_out,*)"merge out_DVDB POT1 POT2 Merge list of POT files, produce out_DVDB file."
114 : 0 : write(std_out,*)"info out_DVDB Print information on DVDB file"
115 : 0 : write(std_out,*)"-h, --help Show this help and exit."
116 : 0 : write(std_out,*)" "
117 : 0 : write(std_out,*)"=== Options for developers ==="
118 : 0 : write(std_out,*)" "
119 : 0 : write(std_out,*)"test_v1complete FILE [--symv1scf 1] [--potfile foo.nc]"
120 : 0 : write(std_out,*)" Test symmetrization of DFPT potentials with symv1scf option"
121 : 0 : write(std_out,*)" Assume DVDB with all 3*natom perturbations for each q (use prep_gkk)."
122 : 0 : write(std_out,*)"test_v1rsym [--symv1scf] Test symmetries of DFPT potentials in real space."
123 : 0 : write(std_out,*)"test_ftinterp in_DVDB --ngqpt 4 4 4 [--ddb-path] [--dvdb-add-lr 0] [--qdamp -1]"
124 : 0 : write(std_out,*)" [--symv1scf] [--coarse-ngqpt 2 2 2] [--potfile foo.nc]"
125 : 0 : write(std_out,*)" Test Fourier interpolation of DFPT potentials."
126 : 0 : write(std_out,*)" --potfile: dump ab-initio and interpolated V1(r) to netcdf for plotting."
127 : 0 : write(std_out,*)"test_symcheck in_DVDB --ngqpt 4 4 4 --qpt 0.1 0.2 0.3 [--ddb-path]"
128 : 0 : write(std_out,*)" [--dvdb-add-lr 0] [--qdamp -1] [--symv1scf] [--rspace_cell 1]"
129 : 0 : write(std_out,*)" [--potfile foo.nc]"
130 : 0 : write(std_out,*)" Test cross-q-point symmetry consistency of the FT interpolation:"
131 : 0 : write(std_out,*)" interpolate at --qpt and at S.qpt for every symmetry S, compare"
132 : 0 : write(std_out,*)" against v1phq_rotate's own prediction from --qpt alone."
133 : 0 : write(std_out,*)" --potfile: dump target/predicted V1(r) to netcdf for plotting."
134 : 0 : write(std_out,*)"test_symcheck_native in_DVDB --sym-dvdb other_DVDB --qpt_source 0.25 0 0"
135 : 0 : write(std_out,*)" --qpt_target -0.25 0 0 [--isym 2] [--itimrev 1] [--g0q 0 0 0]"
136 : 0 : write(std_out,*)" Like test_symcheck but on TWO LITERAL, already-present q-points"
137 : 0 : write(std_out,*)" (no Fourier interpolation at all): tests v1phq_rotate alone."
138 : 0 : write(std_out,*)" --sym-dvdb supplies the crystal's TRUE symmetry table (in_DVDB's"
139 : 0 : write(std_out,*)" own is typically nsym=1, e.g. if built to force literal, per-q"
140 : 0 : write(std_out,*)" independent computation of every perturbation)."
141 : 0 : write(std_out,*)"downsample in_DVDB out_DVDB [n1, n2, n3] Produce new DVDB with q-subsmesh"
142 : 0 : goto 100
143 : : end if
144 : : end do
145 : :
146 : 0 : call get_command_argument(1, command)
147 : :
148 : 0 : select case (command)
149 : : case ("merge")
150 : : ! Get name of output database and list of v1 files.
151 [ # # ]: 0 : ABI_CHECK(nargs > 1, "Additional arguments are missing")
152 : 0 : call get_command_argument(2, dvdb_filepath)
153 [ # # ]: 0 : if (file_exists(dvdb_filepath)) then
154 : 0 : ABI_ERROR(sjoin("Cannot overwrite existing file:", dvdb_filepath))
155 : : end if
156 : :
157 : 0 : nfiles = nargs - 2
158 [ # # # # : 0 : ABI_MALLOC(v1files, (nfiles))
# # # # #
# # # #
# ]
159 [ # # ]: 0 : do ii=1,nfiles
160 : 0 : call get_command_argument(ii+2, v1files(ii))
161 : : end do
162 : :
163 : : ! Merge POT files.
164 : 0 : call dvdb_merge_files(nfiles, v1files, dvdb_filepath, prtvol)
165 [ # # ]: 0 : ABI_FREE(v1files)
166 : :
167 : : case ("info")
168 : : ! Get name of output database and list of v1 files.
169 [ # # ]: 0 : ABI_CHECK(nargs > 1, "Additional arguments are missing")
170 : 0 : call get_command_argument(2, dvdb_filepath)
171 : :
172 : 0 : call dvdb%init(dvdb_filepath, gpu_option0, comm)
173 [ # # # # ]: 0 : if (prtvol > 0) call dvdb%print([std_out], "", prtvol=prtvol)
174 : 0 : call dvdb%list_perts([-1, -1, -1], npert_miss)
175 : 0 : call dvdb%free()
176 : :
177 : : case ("test_v1comp", "test_v1complete")
178 : 0 : call wrtout(std_out," Testing symmetries (assuming overcomplete DVDB, pass extra argument to dump v1(r)) to file")
179 : 0 : call get_command_argument(2, dvdb_filepath)
180 [ # # ]: 0 : ABI_CHECK(get_arg("symv1scf", symv1scf, msg, default=0) == 0, msg)
181 [ # # ]: 0 : ABI_CHECK(get_arg("potfile", dump_file, msg, default="") == 0, msg)
182 : 0 : call dvdb_test_v1complete(dvdb_filepath, symv1scf, dump_file, comm)
183 : :
184 : : case ("test_v1rsym")
185 : 0 : call wrtout(std_out," Testing symmetries of V1(r) in real space.")
186 : 0 : call get_command_argument(2, dvdb_filepath)
187 [ # # ]: 0 : ABI_CHECK(get_arg("symv1scf", symv1scf, msg, default=0) == 0, msg)
188 : 0 : call dvdb_test_v1rsym(dvdb_filepath, symv1scf, comm)
189 : :
190 : : case ("test_ftinterp")
191 : 0 : call get_command_argument(2, dvdb_filepath)
192 [ # # ]: 0 : ABI_CHECK(get_arg_list("ngqpt", ngqpt, lenr, msg, default=2, want_len=3) == 0, msg)
193 [ # # ]: 0 : ABI_CHECK(get_arg("ddb-path", ddb_filepath, msg, default="") == 0, msg)
194 [ # # ]: 0 : ABI_CHECK(get_arg("rspace_cell", rspace_cell, msg, default=0) == 0, msg)
195 [ # # ]: 0 : ABI_CHECK(get_arg("symv1scf", symv1scf, msg, default=0) == 0, msg)
196 [ # # ]: 0 : ABI_CHECK(get_arg("dvdb-add-lr", dvdb_add_lr, msg, default=1) == 0, msg)
197 [ # # ]: 0 : ABI_CHECK(get_arg("qdamp", dvdb_qdamp, msg, default=0.1_dp) == 0, msg)
198 [ # # ]: 0 : ABI_CHECK(get_arg_list("coarse-ngqpt", coarse_ngqpt, lenr, msg, default=0, want_len=3) == 0, msg)
199 [ # # ]: 0 : ABI_CHECK(get_arg("potfile", dump_file, msg, default="") == 0, msg)
200 : : call dvdb_test_ftinterp(dvdb_filepath, rspace_cell, symv1scf, ngqpt, dvdb_add_lr, dvdb_qdamp, &
201 : 0 : ddb_filepath, prtvol, coarse_ngqpt, dump_file, comm)
202 : :
203 : : case ("test_symcheck")
204 : 0 : call get_command_argument(2, dvdb_filepath)
205 [ # # ]: 0 : ABI_CHECK(get_arg_list("ngqpt", ngqpt, lenr, msg, want_len=3) == 0, msg)
206 [ # # ]: 0 : ABI_CHECK(get_arg_list("qpt", qpt_source, lenr, msg, want_len=3) == 0, msg)
207 [ # # ]: 0 : ABI_CHECK(get_arg("ddb-path", ddb_filepath, msg, default="") == 0, msg)
208 [ # # ]: 0 : ABI_CHECK(get_arg("rspace_cell", rspace_cell, msg, default=0) == 0, msg)
209 [ # # ]: 0 : ABI_CHECK(get_arg("symv1scf", symv1scf, msg, default=0) == 0, msg)
210 [ # # ]: 0 : ABI_CHECK(get_arg("dvdb-add-lr", dvdb_add_lr, msg, default=1) == 0, msg)
211 [ # # ]: 0 : ABI_CHECK(get_arg("qdamp", dvdb_qdamp, msg, default=0.1_dp) == 0, msg)
212 [ # # ]: 0 : ABI_CHECK(get_arg("potfile", dump_file, msg, default="") == 0, msg)
213 : : call dvdb_test_symcheck(dvdb_filepath, rspace_cell, symv1scf, ngqpt, dvdb_add_lr, dvdb_qdamp, &
214 : 0 : ddb_filepath, prtvol, qpt_source, dump_file, comm)
215 : :
216 : : case ("test_symcheck_native")
217 : 0 : call get_command_argument(2, dvdb_filepath)
218 [ # # ]: 0 : ABI_CHECK(get_arg("sym-dvdb", ddb_filepath, msg, default="") == 0, msg)
219 [ # # ]: 0 : ABI_CHECK(get_arg_list("qpt_source", qpt_source, lenr, msg, want_len=3) == 0, msg)
220 [ # # ]: 0 : ABI_CHECK(get_arg_list("qpt_target", qpt_target, lenr, msg, want_len=3) == 0, msg)
221 [ # # ]: 0 : ABI_CHECK(get_arg("isym", isym, msg, default=1) == 0, msg)
222 [ # # ]: 0 : ABI_CHECK(get_arg("itimrev", itimrev, msg, default=1) == 0, msg)
223 [ # # ]: 0 : ABI_CHECK(get_arg_list("g0q", g0q, lenr, msg, default=0, want_len=3) == 0, msg)
224 : 0 : call dvdb_test_symcheck_native(dvdb_filepath, ddb_filepath, qpt_source, qpt_target, isym, itimrev, g0q, comm)
225 : :
226 : : case ("downsample")
227 : 0 : call get_command_argument(2, dvdb_filepath)
228 : 0 : call get_command_argument(3, dump_file)
229 [ # # ]: 0 : ABI_CHECK(get_arg_list("ngqpt", ngqpt, lenr, msg, want_len=3) == 0, msg)
230 [ # # ]: 0 : ABI_CHECK(get_arg("qptopt", qptopt, msg, default=1) == 0, msg)
231 : 0 : write(std_out,"(a)")sjoin(" Downsampling q-mesh with ngqpt:", ltoa(ngqpt))
232 : 0 : write(std_out,"(a)")sjoin(" qptopt:", itoa(qptopt))
233 [ # # # # ]: 0 : write(std_out,"(a)")trim(dvdb_filepath), " --> ", trim(dump_file)
234 : :
235 : 0 : call dvdb%init(dvdb_filepath, gpu_option0, xmpi_comm_self)
236 : 0 : call ngfft_seq(ngfftf, dvdb%ngfft3_v1(:, 1))
237 : 0 : call dvdb%open_read(ngfftf, xmpi_comm_self)
238 [ # # # # ]: 0 : if (prtvol > 0) call dvdb%print([std_out], "", prtvol)
239 : 0 : call dvdb%list_perts([-1,-1,-1], npert_miss, unit=std_out)
240 : 0 : call dvdb%qdownsample(dump_file, qptopt, ngqpt, comm)
241 : 0 : call dvdb%free()
242 : :
243 : : case default
244 [ # # # # : 0 : ABI_ERROR(sjoin("Unknown command:", command))
# # # #
# ]
245 : : end select
246 : :
247 : : end if
248 : :
249 : 34 : call wrtout(std_out," Done")
250 : 34 : call abinit_doctor("__mrgdv")
251 : :
252 : 34 : 100 call xmpi_end()
253 : :
254 : 0 : end program mrgdv
255 : : !!***
|
