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 : !!***
|
