Line data Source code
1 : !!****p* ABINIT/aim
2 : !! NAME
3 : !! aim
4 : !!
5 : !! FUNCTION
6 : !! Main routine for Bader Atom-In-Molecule analysis.
7 : !!
8 : !! COPYRIGHT
9 : !! Copyright (C) 2002-2026 ABINIT group (PCasek,FF,XG)
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 : !! WARNING
22 : !! ABINIT rules are not yet followed in the present routine.
23 : !!
24 : !! SOURCE
25 :
26 : #if defined HAVE_CONFIG_H
27 : #include "config.h"
28 : #endif
29 :
30 : #include "abi_common.h"
31 :
32 10 : program aim
33 :
34 10 : use defs_basis
35 : use m_abicore
36 : use m_xmpi
37 : use m_errors
38 : use m_nctk
39 : use netcdf
40 :
41 : use m_build_info, only : abinit_version
42 : use m_time, only : timein
43 : use m_io_tools, only : open_file, file_exists
44 : use m_specialmsg, only : specialmsg_getcount, herald
45 : use m_fstrings, only : int2char4
46 : use m_bader !, only : adini, drvaim, inpar, defad, aim_shutdown
47 :
48 : implicit none
49 :
50 : !Arguments -----------------------------------
51 :
52 : !Local variables-------------------------------
53 : integer,parameter :: master = 0
54 : integer :: fin,ii,ios,iunt,ierr,nfcfile
55 : ! Allow for maximum of 100 fc files
56 : integer,parameter :: natm=500
57 : integer :: lenstr,me,nproc,comm
58 : real(dp) :: tcpu,tcpui,twall,twalli
59 : real(dp) :: tsec(2)
60 : character(len=fnlen) :: dnfile,hname,infile,ofile,tmpfilename
61 : character(len=strlen) :: instr
62 : character(len=10) :: procstr
63 : character(len=24) :: codename
64 : type(aim_dataset_type) :: aim_dtset
65 : character(len=500) :: msg
66 : character(len=fnlen) :: fcfile(natm)
67 : !******************************************************************
68 :
69 : !Change communicator for I/O (mandatory!)
70 10 : call abi_io_redirect(new_io_comm=xmpi_world)
71 :
72 : !Initialize MPI
73 10 : call xmpi_init()
74 :
75 10 : comm = xmpi_world
76 :
77 10 : me=xmpi_comm_rank(comm); nproc=xmpi_comm_size(comm)
78 :
79 : !Initialize memory profiling if it is activated
80 : !if a full abimem.mocc report is desired, set the argument of abimem_init to "2" instead of "0"
81 : !note that abimem.mocc files can easily be multiple GB in size so don't use this option normally
82 : #ifdef HAVE_MEM_PROFILING
83 : call abimem_init(0)
84 : #endif
85 :
86 10 : call timein(tcpui,twalli)
87 :
88 : !Initialize the code, master only : write heading, and read names of files.
89 10 : if (me == master) then
90 10 : read(*,'(a)') infile
91 10 : infile = trim(infile)
92 10 : read(*,'(a)') dnfile
93 10 : dnfile = trim(dnfile)
94 10 : read(*,'(a)') ofile
95 10 : ofile = trim(ofile)
96 28 : do ii=1,natm
97 28 : iunt=unt+ii
98 28 : read(*,'(a)',iostat=ios) fcfile(ii)
99 28 : if (ios /=0) exit
100 : end do
101 10 : nfcfile=ii-1
102 : end if
103 :
104 : !Transfer file names to other procs
105 10 : call xmpi_bcast (infile, master, comm, ierr)
106 10 : call xmpi_bcast (dnfile, master, comm, ierr)
107 10 : call xmpi_bcast (ofile, master, comm, ierr)
108 10 : call xmpi_bcast (nfcfile, master, comm, ierr)
109 28 : do ii=1,nfcfile
110 28 : call xmpi_bcast (fcfile(ii), master, comm, ierr)
111 : end do
112 :
113 : !Prepare initialization of the log and output files
114 10 : fin=len_trim(ofile)
115 10 : hname(1:fin)=ofile(1:fin)
116 10 : hname(fin+1:fin+1)='.'
117 10 : untout=14
118 10 : codename='AIM '//repeat(' ',18)
119 :
120 : !Open main output file and main log file, then print herald at top of files
121 10 : if(me==master)then
122 :
123 10 : hname(fin+2:fin+4)='out'
124 10 : if (open_file(hname(1:fin+4),msg,unit=untout,status='unknown',form='formatted') /= 0) then
125 0 : ABI_ERROR(msg)
126 : end if
127 10 : rewind (unit=untout)
128 10 : call herald(codename,abinit_version,untout)
129 10 : call herald(codename,abinit_version,std_out)
130 : end if
131 :
132 : !Open log file for non-master procs, then print herald at top of files
133 10 : if (me /= master) then
134 0 : call int2char4(me, procstr)
135 0 : tmpfilename = hname(1:fin) // "_LOG_P" // trim(procstr)
136 : !close(std_out)
137 0 : if (open_file(tmpfilename, msg, newunit=std_out, status='unknown',form='formatted') /= 0) then
138 0 : ABI_ERROR(msg)
139 : end if
140 0 : rewind (unit=std_out)
141 0 : call herald(codename,abinit_version,std_out)
142 : end if
143 :
144 10 : unt=21 ! WARNING : this number is used to define other unit numbers, in init.f
145 10 : unt0=9
146 :
147 10 : unto=6 ! XG020629 use standard IO unit => easier testing . So, should replace everywhere unto by std_out
148 :
149 10 : untc=11
150 10 : unts=12
151 10 : untad=19
152 10 : untd=17
153 10 : untl=18
154 10 : unta=15
155 10 : untp=13
156 10 : untg=20
157 :
158 : !OPENING OF THE INPUT FILES
159 :
160 10 : aim_iomode = IO_MODE_FORTRAN
161 10 : if(me==master)then
162 10 : if (open_file(infile,msg,unit=unt0,status='old',form='formatted') /= 0) then
163 0 : ABI_ERROR(msg)
164 : end if
165 :
166 10 : if (file_exists(dnfile)) then
167 0 : if (open_file(dnfile,msg,unit=untad,status='old',form='unformatted') /=0) then
168 0 : ABI_ERROR(msg)
169 : end if
170 : else
171 10 : if (file_exists(nctk_ncify(dnfile))) then
172 : ! Use netcdf-io
173 10 : write(std_out,"(3a)")"- File: ",trim(dnfile)," does not exist but found netcdf file with similar name."
174 10 : dnfile = nctk_ncify(dnfile)
175 10 : aim_iomode = IO_MODE_ETSF
176 10 : NCF_CHECK(nctk_open_read(untad, dnfile, xmpi_comm_self))
177 : else
178 10 : ABI_ERROR('Missing data file: '//TRIM(dnfile))
179 : end if
180 : end if
181 :
182 28 : do ii=1,nfcfile
183 18 : iunt=unt+ii
184 28 : if (open_file(fcfile(ii),msg,unit=iunt,status='old',form='formatted') /= 0) then
185 0 : ABI_ERROR(msg)
186 : end if
187 : end do
188 : end if
189 10 : call xmpi_bcast(aim_iomode, master, comm, ierr)
190 :
191 : !call dump_config(std_out)
192 :
193 : !READING OF THE MAIN INPUT FILE
194 :
195 : !Setting the input variables to their default values
196 10 : call defad(aim_dtset)
197 :
198 : !Reading of the input file -> one string called instr
199 10 : if(me==master)then
200 10 : call inpar(instr,lenstr)
201 : end if
202 10 : call xmpi_bcast (lenstr, master, comm, ierr)
203 10 : call xmpi_bcast (instr(1:lenstr), master, comm, ierr)
204 :
205 : !Analysis of the input string, setting of input variables in aim_dtset
206 10 : call adini(aim_dtset,instr,lenstr)
207 :
208 : !OPENING OF THE OUTPUT FILES
209 10 : if(me==master)then
210 :
211 10 : if (aim_dtset%isurf/=0) hname(fin+2:fin+5)='surf'
212 :
213 10 : if (aim_dtset%isurf==1) then
214 10 : ierr = open_file(hname(1:fin+5),msg,unit=unts,status='unknown',form='formatted')
215 0 : elseif (aim_dtset%isurf==-1) then
216 0 : ierr = open_file(hname(1:fin+5),msg,unit=unts,status='old',action='read',form='formatted')
217 : end if
218 10 : if (ierr /= 0) then
219 0 : ABI_ERROR(msg)
220 : end if
221 :
222 10 : if (aim_dtset%crit/=0) hname(fin+2:fin+5)='crit'
223 :
224 10 : if (aim_dtset%crit>0) then
225 10 : ierr = open_file(hname(1:fin+5),msg,unit=untc,status='unknown',form='formatted')
226 0 : else if (aim_dtset%crit==-1) then
227 0 : ierr = open_file(hname(1:fin+5),msg,unit=untc,status='old',action='read',form='formatted')
228 : end if
229 10 : if (ierr /= 0) then
230 0 : ABI_ERROR(msg)
231 : end if
232 :
233 10 : if (aim_dtset%denout==1) then
234 0 : hname(fin+2:fin+4)='dn1'
235 0 : ierr = open_file(hname(1:fin+4),msg,unit=untd,status='unknown',form='formatted')
236 10 : elseif (aim_dtset%denout==2) then
237 0 : hname(fin+2:fin+4)='dn2'
238 0 : ierr = open_file(hname(1:fin+4),msg,unit=untd,status='unknown',form='formatted')
239 10 : elseif (aim_dtset%denout==3) then
240 0 : hname(fin+2:fin+4)='dn3'
241 0 : ierr = open_file(hname(1:fin+4),msg,unit=untd,status='unknown',form='formatted')
242 10 : elseif (aim_dtset%denout==-1) then
243 0 : hname(fin+2:fin+4)='dna'
244 0 : ierr = open_file(hname(1:fin+4),msg,unit=untd,status='unknown',form='unformatted')
245 : end if
246 :
247 10 : if (ierr /= 0) then
248 0 : ABI_ERROR(msg)
249 : end if
250 :
251 10 : if (aim_dtset%lapout==1) then
252 0 : hname(fin+2:fin+4)='lp1'
253 0 : ierr = open_file(hname(1:fin+4),msg,unit=untl,status='unknown',form='formatted')
254 10 : elseif (aim_dtset%lapout==2) then
255 0 : hname(fin+2:fin+4)='lp2'
256 0 : ierr = open_file(hname(1:fin+4),msg,unit=untl,status='unknown',form='formatted')
257 10 : elseif (aim_dtset%lapout==3) then
258 0 : hname(fin+2:fin+4)='lp3'
259 0 : ierr = open_file(hname(1:fin+4),msg,unit=untl,status='unknown',form='formatted')
260 10 : elseif (aim_dtset%lapout==-1) then
261 0 : hname(fin+2:fin+4)='lpa'
262 0 : ierr = open_file(hname(1:fin+4),msg,unit=untl,status='unknown',form='unformatted')
263 : end if
264 :
265 10 : if (ierr /= 0) then
266 0 : ABI_ERROR(msg)
267 : end if
268 :
269 10 : if (aim_dtset%gpsurf==1) then
270 10 : hname(fin+2:fin+3)='gp'
271 10 : if (open_file(hname(1:fin+3),msg,unit=untg,status='unknown',form='formatted') /= 0) then
272 0 : ABI_ERROR(msg)
273 : end if
274 : end if
275 :
276 10 : if (aim_dtset%plden==1) then
277 0 : hname(fin+2:fin+4)='pld'
278 0 : if (open_file(hname(1:fin+5),msg,unit=untp,status='unknown',form='formatted') /= 0) then
279 0 : ABI_ERROR(msg)
280 : end if
281 : end if
282 :
283 : end if
284 :
285 10 : call timein(tcpu,twall)
286 10 : tsec(1)=tcpu-tcpui
287 10 : tsec(2)=twall-twalli
288 : write(std_out, '(5a,f13.1,a,f13.1)' ) &
289 10 : & '-',ch10,'- After reading the input file and opening the output files ',ch10,&
290 20 : & '- Proc. 0 individual time (sec): cpu=',tsec(1),' wall=',tsec(2)
291 :
292 : !MAIN DRIVER OF THE ANALYSIS
293 :
294 10 : write(std_out,'(a,a,a,a,i4)' )char(10),&
295 20 : & ' aim : read density file ',trim(dnfile),' from unit number ',untad
296 :
297 10 : call drvaim(aim_dtset,tcpui,twalli)
298 :
299 : !THE TOTAL TIME NEEDED
300 10 : call timein(tcpu,twall)
301 10 : tsec(1)=tcpu-tcpui
302 10 : tsec(2)=twall-twalli
303 : write(std_out, '(a,a,a,f13.1,a,f13.1)' ) &
304 10 : & '-',ch10,'- Proc. 0 individual time (sec): cpu=',tsec(1),' wall=',tsec(2)
305 :
306 : write(std_out,'(/," Time needed (seconds) - total, CP analyse, SURF determination:",/,/,"- ",3F16.8)')&
307 10 : & tsec(2),ttcp,ttsrf
308 :
309 :
310 10 : if(me==0)then
311 10 : write(untout,*)
312 10 : write(untout,*) "TIME ANALYSIS"
313 10 : write(untout,*) "============"
314 : write(untout,'(/," Time needed (seconds) - total, CP analyse, SURF determination:",/,/,"- ",3F16.8)') &
315 10 : & tsec(1),ttcp,ttsrf
316 10 : write(untout,'(a,a,f11.3,a,f11.3,a,a,a,a)') char(10),&
317 10 : & '+Total cpu time',tsec(1),&
318 10 : & ' and wall time',tsec(2),' sec',char(10),char(10),&
319 20 : & ' aim : the run completed succesfully.'
320 : end if
321 :
322 : !CLOSING OF THE FILES
323 10 : if(me==0)then
324 10 : close(unt0)
325 10 : close(untout)
326 10 : if (aim_dtset%isurf/=0) close(unts)
327 10 : if (aim_dtset%crit/=0) close(untc)
328 10 : if (aim_dtset%denout/=0) close(untd)
329 10 : if (aim_dtset%lapout/=0) close(untl)
330 10 : if (aim_dtset%gpsurf/=0) close(untg)
331 10 : if (aim_dtset%plden/=0) close(untp)
332 : end if
333 :
334 10 : call aim_shutdown()
335 :
336 : !call abinit_doctor("__aim")
337 :
338 : !Eventual cleaning of MPI run
339 10 : call xmpi_end()
340 :
341 0 : end program aim
342 : !!***
|
