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