Line data Source code
1 : !!****p* ABINIT/mrgddb
2 : !! NAME
3 : !! mrgddb
4 : !!
5 : !! FUNCTION
6 : !! This code merges the derivative databases.
7 : !!
8 : !! COPYRIGHT
9 : !! Copyright (C) 1998-2026 ABINIT group (DCA, XG, GMR, SP, GA)
10 : !! This file is distributed under the terms of the
11 : !! GNU General Public License, 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 : !! INPUTS
16 : !! (main routine)
17 : !!
18 : !! OUTPUT
19 : !! (main routine)
20 : !!
21 : !! NOTES
22 : !! The heading of the constituted database is read,
23 : !! then the heading of the temporary database to be added is read,
24 : !! the code check their compatibility, and create a new
25 : !! database that mixes the old and the temporary ones.
26 : !! This process can be iterated.
27 : !! The whole database will be stored in
28 : !! central memory. One could introduce a third mode in which
29 : !! only the temporary DDB is in central memory, while the
30 : !! input DDB is read twice: first to make a table of blocks,
31 : !! counting the final number of blocks, and second to merge
32 : !! the two DDBs. This would save memory.
33 : !!
34 : !! SOURCE
35 :
36 : #if defined HAVE_CONFIG_H
37 : #include "config.h"
38 : #endif
39 :
40 : #include "abi_common.h"
41 :
42 94 : program mrgddb
43 :
44 94 : use defs_basis
45 : use m_abicore
46 : use m_errors
47 : use m_xmpi
48 : use m_ddb_hdr
49 : use m_ddb
50 :
51 : use m_build_info, only : abinit_version
52 : use m_specialmsg, only : herald
53 : use m_time , only : asctime, timein
54 : use m_io_tools, only : file_exists
55 : use m_fstrings, only : sjoin
56 :
57 : implicit none
58 :
59 : !Local variables-------------------------------
60 : !scalars
61 : integer,parameter :: ddbun=2
62 : integer :: chkopt,ios, mddb
63 : integer :: iddb,ii,nddb,nfiles_cli,nargs,comm,my_rank
64 : real(dp) :: tcpu,tcpui,twall,twalli
65 : logical :: cannot_overwrite=.True.
66 : character(len=24) :: codename
67 : character(len=fnlen) :: dscrpt, outname
68 : !arrays
69 : real(dp) :: tsec(2)
70 94 : character(len=fnlen),allocatable :: filnam(:),copy_filnam(:)
71 : character(len=500) :: msg,arg
72 : !******************************************************************
73 :
74 : ! Change communicator for I/O (mandatory!)
75 94 : call abi_io_redirect(new_io_comm=xmpi_world)
76 :
77 : ! Initialize MPI
78 94 : call xmpi_init()
79 94 : comm = xmpi_world; my_rank = xmpi_comm_rank(comm)
80 :
81 : ! Initialize memory profiling if it is activated
82 : ! if a full abimem.mocc report is desired, set the argument of abimem_init to "2" instead of "0"
83 : ! note that abimem.mocc files can easily be multiple GB in size so don't use this option normally
84 : #ifdef HAVE_MEM_PROFILING
85 : call abimem_init(0)
86 : #endif
87 :
88 94 : call timein(tcpui,twalli)
89 :
90 94 : codename='MRGDDB'//repeat(' ',18)
91 94 : call herald(codename,abinit_version,std_out)
92 :
93 94 : ABI_CHECK(xmpi_comm_size(comm)==1, "mrgddb not programmed for parallel execution")
94 :
95 94 : nargs = command_argument_count()
96 :
97 94 : mddb = 5000 ! maximum number of databases (initial guess)
98 :
99 94 : chkopt = 1; nfiles_cli = 0
100 94 : do ii=1,nargs
101 0 : call get_command_argument(ii, arg)
102 94 : if (arg == "-v" .or. arg == "--version") then
103 0 : write(std_out,"(a)") trim(abinit_version); goto 100
104 :
105 0 : else if (arg == "--nostrict") then
106 : ! Disable consistency checks
107 0 : chkopt = 0
108 :
109 0 : else if (arg == "-f") then
110 0 : cannot_overwrite = .False.
111 :
112 0 : else if (arg == "-h" .or. arg == "--help") then
113 : ! Document the options.
114 0 : write(std_out,*)"Usage:"
115 0 : write(std_out,*)" mrgddb Interactive prompt."
116 0 : write(std_out,*)" mrgddb < run.files Read arguments from run.files."
117 0 : write(std_out,*)" mrgddb out_DDB in1_DDB in2_DDB Merge list of input DDB files, produce new out_DDB file."
118 0 : write(std_out,*)" mrgddb out_DDB in*_DDB Same as above but use shell wildcards instead of file list."
119 0 : write(std_out,*)" mrgddb out_DDB in_DDB.nc Convert DDB from NetCDF format to plain text format."
120 0 : write(std_out,*)" mrgddb out_DDB.nc in_DDB Convert DDB from plain text to NetCDF format."
121 0 : write(std_out,*)" "
122 0 : write(std_out,*)"Available options:"
123 0 : write(std_out,*)" -v, --version Show version number and exit."
124 0 : write(std_out,*)" -f Overwrite output DDB if file already exists."
125 0 : write(std_out,*)" --nostrict Disable consistency checks"
126 0 : write(std_out,*)" -h, --help Show this help and exit."
127 0 : goto 100
128 :
129 : else
130 0 : if (ii == 1) then
131 : ! First arg is the name of the output file.
132 0 : outname = trim(arg); cycle
133 : end if
134 :
135 : ! Save filenames passed via command-line.
136 0 : if (.not. allocated(filnam)) then
137 0 : ABI_MALLOC(filnam, (mddb+1))
138 : end if
139 0 : nfiles_cli = nfiles_cli + 1
140 0 : if (nfiles_cli > mddb + 1) then
141 : ! Extend filnam
142 0 : ABI_MALLOC(copy_filnam, (mddb+1))
143 0 : copy_filnam = filnam
144 0 : iddb = mddb + 1
145 0 : mddb = 2 * mddb
146 0 : ABI_FREE(filnam)
147 0 : ABI_MALLOC(filnam, (mddb+1))
148 0 : filnam(:iddb) = copy_filnam(:iddb)
149 0 : ABI_FREE(copy_filnam)
150 : end if
151 0 : filnam(nfiles_cli) = trim(arg)
152 : end if
153 : end do ! nargs
154 :
155 94 : if (nfiles_cli == 0) then
156 : ! Read names of files, operating mode (also check its value),
157 : ! and short description of new database.
158 :
159 : ! Read the name of the output ddb
160 94 : write(std_out,*)' Give name for output derivative database : '
161 94 : read(std_in, '(a)' ) outname
162 94 : write(std_out,'(2a)' )' ',trim(outname)
163 :
164 : ! Read the description of the derivative database
165 94 : write(std_out,*)' Give short description of the derivative database :'
166 94 : read(std_in, '(a)' )dscrpt
167 94 : write(std_out,'(2a)' )' ',trim(dscrpt)
168 :
169 : ! Read the number of input ddbs, and check its value
170 : ! MG NOTE: In the documentation of mrgddb_init I found:
171 : !
172 : ! nddb = (=1 => will initialize the ddb, using an input GS file)
173 : ! (>1 => will merge the whole set of ddbs listed)
174 : ! if nddb==1,
175 : ! (2) Formatted input file for the Corning ground-state code
176 : !
177 : ! but the case nddb=1 with input file is not supported anymore!
178 :
179 94 : write(std_out,*)' Give number of input ddbs'
180 94 : read(std_in,*)nddb
181 94 : write(std_out,*)nddb
182 94 : ABI_MALLOC(filnam, (nddb))
183 :
184 : ! Read the file names
185 580 : do iddb=1,nddb
186 : !Added to catch error message if the number of input ddbs is greater than the
187 : !actual number of ddb files entered by the user.
188 486 : read(std_in, '(a)',IOSTAT =ios ) filnam(iddb)
189 580 : if (ios < 0) then
190 : write(msg, '(a,i0,4a)' )&
191 0 : 'The number of input ddb files: ',nddb,' exceeds the number ',&
192 0 : 'of ddb file names.', ch10, &
193 0 : 'Action: change the number of ddb files in the mrgddb input file.'
194 0 : ABI_ERROR(msg)
195 : else
196 486 : write(std_out,*)' Give name for derivative database number',iddb,' : '
197 486 : write(std_out,'(2a)' )' ',trim(filnam(iddb))
198 : end if
199 : end do
200 :
201 : else
202 0 : if (cannot_overwrite .and. file_exists(outname)) then
203 0 : ABI_ERROR(sjoin("Cannot overwrite existing file:", outname))
204 : end if
205 0 : nddb = nfiles_cli
206 0 : dscrpt = sjoin("Generated by mrgddb on:", asctime())
207 : end if
208 :
209 : ! Call the main merging routine
210 94 : call merge_ddb(nddb, filnam, outname, dscrpt, chkopt)
211 :
212 94 : ABI_FREE(filnam)
213 :
214 : !**********************************************************************
215 :
216 94 : call timein(tcpu,twall)
217 :
218 94 : tsec(1)=tcpu-tcpui
219 94 : tsec(2)=twall-twalli
220 :
221 94 : write(std_out, '(3a,f13.1,a,f13.1)' ) '-',ch10,'- Proc. 0 individual time (sec): cpu=',tsec(1),' wall=',tsec(2)
222 94 : call wrtout(std_out,'+mrgddb : the run completed successfully ','COLL', do_flush=.True.)
223 :
224 94 : call abinit_doctor("__mrgddb")
225 :
226 94 : 100 call xmpi_end()
227 :
228 0 : end program mrgddb
229 : !!***
|
