|
1
by Yann Pouillon
Imported Wannier90 1.2 |
1 |
!-*- mode: F90; mode: font-lock; column-number-mode: true -*-!
|
2 |
! !
|
|
|
42
by Yann Pouillon
Imported source tarball of Wannier90 2.0.1 |
3 |
! Copyright (C) 2007-13 Jonathan Yates, Arash Mostofi, !
|
4 |
! Giovanni Pizzi, Young-Su Lee, !
|
|
5 |
! Nicola Marzari, Ivo Souza, David Vanderbilt !
|
|
|
1
by Yann Pouillon
Imported Wannier90 1.2 |
6 |
! !
|
7 |
! This file is distributed under the terms of the GNU !
|
|
8 |
! General Public License. See the file `LICENSE' in !
|
|
9 |
! the root directory of the present distribution, or !
|
|
10 |
! http://www.gnu.org/copyleft/gpl.txt . !
|
|
11 |
! !
|
|
12 |
!------------------------------------------------------------!
|
|
13 |
||
|
54
by Yann Pouillon
Added HAVE_CONFIG_H handling to all Fortran files in src/ |
14 |
#if defined HAVE_CONFIG_H
|
15 |
#include "config.h"
|
|
16 |
#endif
|
|
17 |
||
|
1
by Yann Pouillon
Imported Wannier90 1.2 |
18 |
module w90_io |
19 |
||
20 |
use w90_constants, only : dp |
|
21 |
||
22 |
implicit none
|
|
23 |
||
24 |
private
|
|
25 |
||
|
42
by Yann Pouillon
Imported source tarball of Wannier90 2.0.1 |
26 |
|
27 |
#ifdef MPI
|
|
28 |
include 'mpif.h' |
|
29 |
#endif
|
|
30 |
||
|
1
by Yann Pouillon
Imported Wannier90 1.2 |
31 |
integer, public, save :: stdout |
32 |
character(len=50), public, save :: seedname |
|
|
42
by Yann Pouillon
Imported source tarball of Wannier90 2.0.1 |
33 |
integer, parameter, public :: maxlen = 120 ! Max column width of input file |
|
1
by Yann Pouillon
Imported Wannier90 1.2 |
34 |
logical, public, save :: post_proc_flag ! Set post_processing from cmd line |
35 |
||
36 |
type timing_data |
|
37 |
integer :: ncalls |
|
38 |
real(kind=DP) :: ctime |
|
39 |
real(kind=DP) :: ptime |
|
40 |
character(len=60) :: label |
|
41 |
end type timing_data |
|
42 |
||
43 |
integer, parameter :: nmax = 100 |
|
44 |
type(timing_data) :: clocks(nmax) |
|
45 |
integer, save :: nnames=0 |
|
46 |
||
47 |
||
48 |
public :: io_stopwatch |
|
49 |
public :: io_print_timings |
|
50 |
public :: io_get_seedname |
|
51 |
public :: io_time |
|
52 |
public :: io_date |
|
53 |
public :: io_error |
|
54 |
public :: io_file_unit |
|
55 |
||
56 |
contains
|
|
57 |
||
58 |
||
59 |
!==================================================================!
|
|
60 |
subroutine io_stopwatch(tag,mode) |
|
61 |
!==================================================================!
|
|
62 |
! Stopwatch to time parts of the code !
|
|
63 |
!==================================================================!
|
|
64 |
||
65 |
implicit none
|
|
66 |
||
67 |
character(len=*), intent(in) :: tag |
|
68 |
integer, intent(in) :: mode |
|
69 |
||
70 |
integer :: i |
|
71 |
real(kind=dp) :: t |
|
72 |
||
73 |
call cpu_time(t) |
|
74 |
||
75 |
select case (mode) |
|
76 |
||
77 |
case (1) |
|
78 |
||
79 |
do i=1,nnames |
|
80 |
if (clocks(i)%label .eq. tag) then |
|
81 |
clocks(i)%ptime = t |
|
82 |
clocks(i)%ncalls = clocks(i)%ncalls + 1 |
|
83 |
return
|
|
84 |
endif |
|
85 |
enddo
|
|
86 |
||
87 |
nnames = nnames + 1 |
|
88 |
if (nnames.gt.nmax) call io_error('Maximum number of calls to io_stopwatch exceeded') |
|
89 |
||
90 |
clocks(nnames)%label = tag |
|
91 |
clocks(nnames)%ctime = 0.0_dp |
|
92 |
clocks(nnames)%ptime = t |
|
93 |
clocks(nnames)%ncalls = 1 |
|
94 |
||
95 |
case (2) |
|
96 |
||
97 |
do i=1,nnames |
|
98 |
if (clocks(i)%label .eq. tag) then |
|
99 |
clocks(i)%ctime = clocks(i)%ctime + t - clocks(i)%ptime |
|
100 |
return
|
|
101 |
endif |
|
102 |
end do
|
|
103 |
||
104 |
write(stdout,'(1x,3a)') 'WARNING: name = ',trim(tag),' not found in io_stopwatch' |
|
105 |
||
106 |
case default |
|
107 |
||
108 |
write(stdout,*) ' Name = ',trim(tag),' mode = ',mode |
|
109 |
call io_error('Value of mode not recognised in io_stopwatch') |
|
110 |
||
111 |
end select
|
|
112 |
||
113 |
return
|
|
114 |
||
115 |
end subroutine io_stopwatch |
|
116 |
||
117 |
||
118 |
!==================================================================!
|
|
119 |
subroutine io_print_timings() |
|
120 |
!==================================================================!
|
|
121 |
! Output timing information to stdout
|
|
122 |
!==================================================================!
|
|
123 |
||
124 |
implicit none
|
|
125 |
||
126 |
integer :: i |
|
127 |
||
128 |
write(stdout,'(/1x,a)') '*===========================================================================*' |
|
129 |
write(stdout,'(1x,a)') '| TIMING INFORMATION |' |
|
130 |
write(stdout,'(1x,a)') '*===========================================================================*' |
|
131 |
write(stdout,'(1x,a)') '| Tag Ncalls Time (s)|' |
|
132 |
write(stdout,'(1x,a)') '|---------------------------------------------------------------------------|' |
|
133 |
do i=1,nnames |
|
134 |
write(stdout,'(1x,"|",a50,":",i10,4x,f10.3,"|")') & |
|
135 |
clocks(i)%label,clocks(i)%ncalls,clocks(i)%ctime |
|
136 |
enddo |
|
137 |
write(stdout,'(1x,a)') '*---------------------------------------------------------------------------*' |
|
138 |
||
139 |
return
|
|
140 |
||
141 |
end subroutine io_print_timings |
|
142 |
||
143 |
||
144 |
!==================================================================!
|
|
145 |
subroutine io_get_seedname ( ) |
|
146 |
!==================================================================!
|
|
147 |
! !
|
|
148 |
! Get the seedname from the commandline !
|
|
149 |
! Note iargc and getarg are not standard !
|
|
150 |
! Some platforms require them to be external or provide !
|
|
151 |
! equivalent routines. Not a problem in f2003! !
|
|
152 |
!===================================================================
|
|
153 |
||
154 |
||
155 |
#ifdef NAG
|
|
156 |
USE F90_UNIX_ENV, ONLY : IARGC,GETARG |
|
157 |
#endif
|
|
158 |
||
159 |
implicit none
|
|
160 |
||
161 |
integer :: num_arg |
|
162 |
#ifndef NAG
|
|
163 |
integer :: iargc |
|
164 |
#endif
|
|
165 |
character(len=50) :: ctemp |
|
166 |
||
167 |
post_proc_flag=.false. |
|
168 |
||
169 |
num_arg=iargc() |
|
170 |
if (num_arg==0) then |
|
171 |
seedname='wannier' |
|
172 |
elseif (num_arg==1) then |
|
173 |
call getarg(1,seedname) |
|
174 |
if( index(seedname,'-pp')>0 ) then |
|
175 |
post_proc_flag=.true. |
|
176 |
seedname='wannier' |
|
177 |
end if
|
|
178 |
else
|
|
179 |
call getarg(1,seedname) |
|
180 |
if( index(seedname,'-pp')>0 ) then |
|
181 |
post_proc_flag=.true. |
|
182 |
call getarg(2,seedname) |
|
183 |
else
|
|
184 |
call getarg(2,ctemp) |
|
185 |
if( index(ctemp,'-pp')>0 ) post_proc_flag=.true. |
|
186 |
end if
|
|
187 |
||
188 |
end if
|
|
189 |
||
|
42
by Yann Pouillon
Imported source tarball of Wannier90 2.0.1 |
190 |
! If on the command line the whole seedname.win was passed, I strip the last ".win"
|
191 |
if (len(trim(seedname)).ge.5) then |
|
192 |
if (seedname(len(trim(seedname))-4+1:).eq.".win") then |
|
193 |
seedname = seedname(:len(trim(seedname))-4) |
|
194 |
end if
|
|
195 |
end if
|
|
196 |
||
|
1
by Yann Pouillon
Imported Wannier90 1.2 |
197 |
end subroutine io_get_seedname |
198 |
||
199 |
||
200 |
||
201 |
!==================================================================!
|
|
202 |
subroutine io_error ( error_msg ) |
|
203 |
!==================================================================!
|
|
204 |
! !
|
|
205 |
! Aborts giving error message !
|
|
206 |
! !
|
|
207 |
!===================================================================
|
|
208 |
||
|
42
by Yann Pouillon
Imported source tarball of Wannier90 2.0.1 |
209 |
|
|
1
by Yann Pouillon
Imported Wannier90 1.2 |
210 |
implicit none
|
211 |
character(len=*), intent(in) :: error_msg |
|
212 |
||
|
42
by Yann Pouillon
Imported source tarball of Wannier90 2.0.1 |
213 |
#ifdef MPI
|
214 |
character(len=50) :: filename |
|
215 |
integer :: stderr,ierr,whoami |
|
216 |
||
217 |
call mpi_comm_rank(mpi_comm_world, whoami, ierr) |
|
218 |
if(whoami>99999) then |
|
219 |
write(filename,'(a,a,I0,a)')trim(seedname),'.node_',whoami,'.werr' |
|
220 |
else
|
|
221 |
write(filename,'(a,a,I5.5,a)')trim(seedname),'.node_',whoami,'.werr' |
|
222 |
endif
|
|
223 |
stderr=io_file_unit() |
|
224 |
open(unit=stderr,file=trim(filename),form='formatted',err=105) |
|
225 |
write(stderr, '(1x,a)') trim(error_msg) |
|
226 |
close(stderr) |
|
227 |
||
228 |
105 write(*,'(1x,a)') trim(error_msg) |
|
229 |
106 write(*,'(1x,a,I0,a)') "Error on node ", & |
|
230 |
whoami, ": examine the output/error files for details" |
|
231 |
||
232 |
call MPI_abort(MPI_comm_world,1,ierr) |
|
233 |
||
234 |
#else
|
|
235 |
||
|
1
by Yann Pouillon
Imported Wannier90 1.2 |
236 |
write(stdout,*) 'Exiting.......' |
237 |
write(stdout, '(1x,a)') trim(error_msg) |
|
238 |
||
239 |
close(stdout) |
|
240 |
||
|
42
by Yann Pouillon
Imported source tarball of Wannier90 2.0.1 |
241 |
write(*, '(1x,a)') trim(error_msg) |
242 |
write(*,'(A)') "Error: examine the output/error file for details" |
|
243 |
#endif
|
|
244 |
||
245 |
#ifdef EXIT_FLAG
|
|
246 |
call exit(1) |
|
247 |
#else
|
|
248 |
STOP
|
|
249 |
#endif
|
|
|
1
by Yann Pouillon
Imported Wannier90 1.2 |
250 |
|
251 |
end subroutine io_error |
|
252 |
||
253 |
||
254 |
!==================================================================!
|
|
255 |
subroutine io_date(cdate, ctime) |
|
256 |
!==================================================================!
|
|
257 |
! !
|
|
258 |
! Returns two strings containing the date and the time !
|
|
259 |
! in human-readable format. Uses a standard f90 call. !
|
|
260 |
! !
|
|
261 |
!===================================================================
|
|
262 |
implicit none
|
|
263 |
character (len=9), intent(out) :: cdate |
|
264 |
character (len=9), intent(out) :: ctime |
|
265 |
||
266 |
character(len=3), dimension(12) :: months |
|
267 |
data months /'Jan','Feb','Mar','Apr','May','Jun', & |
|
268 |
'Jul','Aug','Sep','Oct','Nov','Dec'/ |
|
269 |
integer date_time(8) |
|
270 |
!
|
|
271 |
call date_and_time(values=date_time) |
|
272 |
!
|
|
273 |
write (cdate,'(i2,a3,i4)') date_time(3), months(date_time(2)), date_time(1) |
|
274 |
write (ctime,'(i2.2,":",i2.2,":",i2.2)') date_time(5), date_time(6), date_time(7) |
|
275 |
||
276 |
end subroutine io_date |
|
277 |
||
278 |
||
279 |
!==================================================================!
|
|
280 |
function io_time() |
|
281 |
!==================================================================!
|
|
282 |
! !
|
|
283 |
! Returns elapsed CPU time in seconds since its first call !
|
|
284 |
! uses standard f90 call !
|
|
285 |
! !
|
|
286 |
!===================================================================
|
|
287 |
use w90_constants, only : dp |
|
288 |
implicit none
|
|
289 |
||
290 |
real(kind=dp) :: io_time |
|
291 |
||
292 |
! t0 contains the time of the first call
|
|
293 |
! t1 contains the present time
|
|
294 |
real(kind=dp) :: t0, t1 |
|
295 |
logical :: first=.true. |
|
296 |
save first, t0 |
|
297 |
!
|
|
298 |
call cpu_time(t1) |
|
299 |
!
|
|
300 |
if (first) then |
|
301 |
t0 = t1 |
|
302 |
io_time = 0.0_dp |
|
303 |
first = .false. |
|
304 |
else
|
|
305 |
io_time = t1 - t0 |
|
306 |
endif
|
|
307 |
return
|
|
308 |
end function io_time |
|
309 |
||
310 |
!==================================================================!
|
|
311 |
function io_file_unit() |
|
312 |
!==================================================================!
|
|
313 |
! !
|
|
314 |
! Returns an unused unit number !
|
|
315 |
! (so we can open a file on that unit !
|
|
316 |
! !
|
|
317 |
!===================================================================
|
|
318 |
implicit none
|
|
319 |
||
320 |
integer :: io_file_unit,unit |
|
321 |
logical :: file_open |
|
322 |
||
323 |
unit = 9 |
|
324 |
file_open = .true. |
|
325 |
do while ( file_open ) |
|
326 |
unit = unit + 1 |
|
327 |
inquire( unit, OPENED = file_open ) |
|
328 |
end do
|
|
329 |
||
330 |
io_file_unit = unit |
|
331 |
||
332 |
||
333 |
return
|
|
334 |
end function io_file_unit |
|
335 |
||
336 |
||
337 |
end module w90_io |