Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
fleur
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
52
Issues
52
List
Boards
Labels
Service Desk
Milestones
Operations
Operations
Incidents
Packages & Registries
Packages & Registries
Container Registry
Analytics
Analytics
Repository
Value Stream
Wiki
Wiki
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Commits
Issue Boards
Open sidebar
fleur
fleur
Commits
9e13b3d5
Commit
9e13b3d5
authored
Jan 31, 2019
by
Daniel Wortmann
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Some work on juDFT subroutines to beautify them
parent
b03d6d9f
Changes
5
Hide whitespace changes
Inline
Side-by-side
Showing
5 changed files
with
266 additions
and
159 deletions
+266
-159
juDFT/init.F90
juDFT/init.F90
+9
-9
juDFT/stop.F90
juDFT/stop.F90
+126
-52
juDFT/sysinfo.F90
juDFT/sysinfo.F90
+90
-65
juDFT/time.F90
juDFT/time.F90
+40
-32
main/fleur_job.F90
main/fleur_job.F90
+1
-1
No files found.
juDFT/init.F90
View file @
9e13b3d5
...
...
@@ -49,18 +49,18 @@
INTEGER
::
irank
,
ierr
CALL
MPI_COMM_RANK
(
MPI_COMM_WORLD
,
irank
,
ierr
)
WRITE
(
*
,
*
)
"Signal "
,
signal
,
" detected on PE:"
,
irank
WRITE
(
0
,
*
)
"Signal "
,
signal
,
" detected on PE:"
,
irank
#else
WRITE
(
*
,
*
)
"Signal detected:"
,
signal
WRITE
(
0
,
*
)
"Signal detected:"
,
signal
#endif
WRITE
(
*
,
*
)
"This might be due to either:"
WRITE
(
*
,
*
)
" - A bug in FLEUR
"
WRITE
(
*
,
*
)
" - Your job running out of memory"
WRITE
(
*
,
*
)
" - Your job got killed externally (e.g. no cpu-time left)"
WRITE
(
*
,
*
)
" - ...."
WRITE
(
*
,
*
)
"Please check and report if you believe you found a bug"
WRITE
(
0
,
*
)
"This might be due to either:"
WRITE
(
0
,
*
)
" - A bug
"
WRITE
(
0
,
*
)
" - Your job running out of memory"
WRITE
(
0
,
*
)
" - Your job got killed externally (e.g. no cpu-time left)"
WRITE
(
0
,
*
)
" - ...."
WRITE
(
0
,
*
)
"Please check and report if you believe you found a bug"
CALL
writetimes
()
CALL
PRINT_memory_info
()
CALL
PRINT_memory_info
(
0
,
.true.
)
#ifdef CPP_MPI
CALL
MPI_ABORT
(
MPI_COMM_WORLD
,
ierr
)
#endif
...
...
juDFT/stop.F90
View file @
9e13b3d5
...
...
@@ -45,11 +45,12 @@ CONTAINS
LOGICAL
::
l_exist
INQUIRE
(
file
=
filename
,
exist
=
l_exist
)
IF
(
.not.
l_exist
)
CALL
judft_error
(
"File not readable:"
//
filename
,
hint
=
"
FLEUR wants
to read a file that is not present"
,
warning
=
warning
)
IF
(
.not.
l_exist
)
CALL
judft_error
(
"File not readable:"
//
filename
,
hint
=
"
You tried
to read a file that is not present"
,
warning
=
warning
)
END
SUBROUTINE
judfT_file_readable
SUBROUTINE
juDFT_error
(
message
,
calledby
,
hint
,
no
,
warning
,
file
,
line
)
USE
m_judft_usage
USE
m_xmloutput
IMPLICIT
NONE
CHARACTER
*
(
*
),
INTENT
(
IN
)
::
message
CHARACTER
*
(
*
),
OPTIONAL
,
INTENT
(
IN
)
::
calledby
,
hint
...
...
@@ -58,18 +59,18 @@ CONTAINS
CHARACTER
*
(
*
),
OPTIONAL
,
INTENT
(
IN
)
::
file
INTEGER
,
INTENT
(
IN
),
OPTIONAL
::
line
LOGICAL
::
callstop
,
warn
CHARACTER
(
LEN
=
4
)::
PE
!store all output in variable for single call to write in MPI case
CHARACTER
(
len
=
300
)::
text
(
10
)
INTEGER
::
linenr
,
n
LOGICAL
::
callstop
,
warn
,
first_pe
INTEGER
::
isize
,
irank
,
e
,
i
CHARACTER
(
len
=
100
),
ALLOCATABLE
::
message_list
(:)
#ifdef CPP_MPI
include
'mpif.h'
INTEGER
::
irank
,
e
LOGICAL
::
first_parallel
CALL
MPI_COMM_RANK
(
MPI_COMM_WORLD
,
irank
,
e
)
WRITE
(
PE
,
"(i4)"
)
irank
CALL
MPI_COMM_SIZE
(
MPI_COMM_WORLD
,
isize
,
e
)
#else
PE
=
" ****"
first_pe
=
.TRUE.
isize
=
1
irank
=
0
#endif
warn
=
.FALSE.
IF
(
PRESENT
(
warning
))
warn
=
warning
...
...
@@ -79,60 +80,83 @@ CONTAINS
callstop
=
.false.
ELSE
INQUIRE
(
FILE
=
"JUDFT_WARN_ONLY"
,
EXIST
=
callstop
)
callstop
=
.NOT.
callstop
ENDIF
ELSE
callstop
=
.TRUE.
ENDIF
IF
(
.NOT.
warn
)
THEN
WRITE
(
text
(
1
),
*
)
PE
,
"**************juDFT-Error*****************"
ELSE
WRITE
(
text
(
1
),
*
)
PE
,
"************juDFT-Warning*****************"
ENDIF
WRITE
(
text
(
2
),
"(3a)"
)
PE
,
"Error message:"
,
message
linenr
=
3
IF
(
PRESENT
(
calledby
))
THEN
WRITE
(
text
(
3
),
"(3a)"
)
PE
,
"Error occurred in subroutine:"
,
calledby
linenr
=
4
ENDIF
IF
(
PRESENT
(
hint
))
THEN
WRITE
(
text
(
linenr
),
"(3a)"
)
PE
,
"Hint:"
,
hint
linenr
=
linenr
+1
ENDIF
IF
(
PRESENT
(
no
))
THEN
WRITE
(
text
(
linenr
),
"(2a,i0)"
)
PE
,
"Error number:"
,
no
linenr
=
linenr
+1
ENDIF
IF
(
present
(
file
))
THEN
if
(
present
(
line
))
THEN
write
(
text
(
linenr
),
"(4a,i0)"
)
PE
,
"Source:"
,
file
,
":"
,
line
#ifdef CPP_MPI
CALL
collect_messages
(
message
,
message_list
,
first_pe
)
#endif
IF
(
first_pe
)
THEN
IF
(
.NOT.
warn
)
THEN
WRITE
(
0
,
'(a)'
)
"**************juDFT-Error*****************"
ELSE
write
(
text
(
linenr
),
"(3a)"
)
PE
,
"Source:"
,
file
WRITE
(
0
,
'(a)'
)
"************juDFT-Warning*****************"
ENDIF
WRITE
(
0
,
"(3a)"
)
"Error message:"
,
message
IF
(
PRESENT
(
calledby
))
THEN
WRITE
(
0
,
"(3a)"
)
"Error occurred in subroutine:"
,
calledby
ENDIF
IF
(
PRESENT
(
hint
))
THEN
WRITE
(
0
,
"(3a)"
)
"Hint:"
,
hint
ENDIF
IF
(
PRESENT
(
no
))
THEN
WRITE
(
0
,
"(1a,i0)"
)
"Error number:"
,
no
ENDIF
linenr
=
linenr
+1
IF
(
PRESENT
(
file
))
THEN
IF
(
PRESENT
(
line
))
THEN
WRITE
(
0
,
"(3a,i0)"
)
"Source:"
,
file
,
":"
,
line
ELSE
WRITE
(
0
,
"(3a)"
)
"Source:"
,
file
ENDIF
ENDIF
#ifdef CPP_MPI
WRITE
(
0
,
'(a,i0,a,i0)'
)
"Error from PE:"
,
irank
,
"/"
,
isize
first_parallel
=
.TRUE.
DO
i
=
0
,
isize
-1
IF
(
i
==
irank
)
CYCLE
IF
(
LEN_TRIM
(
message_list
(
i
))
>
1
)
THEN
IF
(
first_parallel
)
THEN
WRITE
(
0
,
'(2a)'
)
"Other PEs with error messages:"
first_parallel
=
.FALSE.
END
IF
WRITE
(
0
,
'(a,i4,2a)'
)
" "
,
i
,
"-"
,
message_list
(
i
)
END
IF
END
DO
#endif
WRITE
(
0
,
'(2a)'
)
"*****************************************"
IF
(
.NOT.
warn
)
CALL
juDFT_time_lastlocation
()
IF
(
callstop
.and.
warn
)
WRITE
(
0
,
'(a)'
)
"Warnings not ignored. Touch 'JUDFT_WARN_ONLY' to make the warning nonfatal"
IF
(
callstop
)
THEN
CALL
writetimes
()
CALL
print_memory_info
(
0
,
.TRUE.
)
IF
(
irank
==
0
)
THEN
!Error on PE0 write info to out and out.xml
WRITE
(
6
,
*
)
"***************ERROR***************"
WRITE
(
6
,
*
)
message
WRITE
(
6
,
*
)
"***************ERROR***************"
CALL
writeXMLElement
(
'ERROR'
,(/
"Message"
/),(/
message
/))
!try closing the out file
CLOSE
(
6
,
iostat
=
e
)
!Try closing the xml-out
CALL
endXMLOutput
()
ENDIF
END
IF
ELSE
CALL
priv_wait
(
2.0
)
ENDIF
WRITE
(
text
(
linenr
),
*
)
PE
,
"*****************************************"
if
(
.not.
warn
)
CALL
juDFT_time_lastlocation
(
PE
)
IF
(
callstop
)
THEN
IF
(
warn
)
THEN
linenr
=
linenr
+1
WRITE
(
text
(
linenr
),
'(a)'
)
"Warnings not ignored. Touch 'JUDFT_WARN_ONLY' to make the warning nonfatal"
ENDIF
WRITE
(
0
,
*
)
WRITE
(
0
,
"(10(a,/))"
)
(
TRIM
(
text
(
n
)),
n
=
1
,
linenr
)
CALL
add_usage_data
(
"Error"
,
message
)
!$OMP MASTER
CALL
send_usage_data
()
!$OMP END MASTER
CALL
juDFT_STOP
()
ENDIF
WRITE
(
0
,
*
)
write
(
0
,
"(10(a,/))"
)
(
trim
(
text
(
n
)),
n
=
1
,
linenr
)
END
SUBROUTINE
juDFT_error
SUBROUTINE
juDFT_warn
(
message
,
calledby
,
hint
,
no
,
file
,
line
)
...
...
@@ -184,7 +208,7 @@ CONTAINS
WRITE
(
0
,
*
)
" "
,
message
WRITE
(
0
,
*
)
"*****************************************"
CALL
writetimes
()
CALL
print_memory_info
()
CALL
print_memory_info
(
0
,
.true.
)
CALL
send_usage_data
()
#ifdef CPP_MPI
IF
(
PRESENT
(
irank
))
THEN
...
...
@@ -209,7 +233,7 @@ CONTAINS
INTEGER
,
OPTIONAL
,
INTENT
(
IN
)
::
errorCode
INTEGER
::
error
LOGICAL
::
calltrace
LOGICAL
,
ALLOCATABLE
::
a
(:)
LOGICAL
,
ALLOCATABLE
::
a
(:)
#ifdef CPP_MPI
INTEGER
::
ierr
#endif
...
...
@@ -218,10 +242,7 @@ CONTAINS
IF
(
PRESENT
(
errorCode
))
THEN
error
=
errorCode
END
IF
!try to print times
call
writelocation
()
CALL
writetimes
(
.TRUE.
)
CALL
print_memory_info
()
!Now try to generate a stack-trace if requested
INQUIRE
(
FILE
=
"JUDFT_TRACE"
,
EXIST
=
calltrace
)
IF
(
judft_was_argument
(
"-trace"
))
calltrace
=
.TRUE.
IF
(
error
.EQ.
1
)
calltrace
=
.TRUE.
...
...
@@ -248,6 +269,59 @@ CONTAINS
END
SUBROUTINE
juDFT_stop
#ifdef CPP_MPI
SUBROUTINE
collect_messages
(
mymessage
,
message_list
,
first_pe
)
!This routine collects all error messages from all PE into an array
!As not all PE might call this routine we use non-blocking communication
!The integer first_pe is true if this pe is the one with the lowest rank among
!all having error messages to report
IMPLICIT
NONE
CHARACTER
(
len
=*
),
INTENT
(
IN
)
::
mymessage
CHARACTER
(
len
=
100
),
ASYNCHRONOUS
,
ALLOCATABLE
,
INTENT
(
OUT
)
::
message_list
(:)
LOGICAL
,
INTENT
(
OUT
)
::
first_pe
INCLUDE
'mpif.h'
INTEGER
::
irank
,
isize
,
ierr
,
i
LOGICAL
::
completed
INTEGER
,
ALLOCATABLE
::
ihandle
(:)
CHARACTER
(
len
=
100
)::
message
REAL
::
t1
,
t2
message
=
mymessage
CALL
MPI_COMM_RANK
(
MPI_COMM_WORLD
,
irank
,
ierr
)
CALL
MPI_COMM_SIZE
(
MPI_COMM_WORLD
,
isize
,
ierr
)
ALLOCATE
(
message_list
(
0
:
isize
-1
))
ALLOCATE
(
ihandle
(
0
:
isize
-1
))
message_list
=
""
!Announce that I have a message to all PE
DO
i
=
0
,
isize
-1
CALL
MPI_ibsend
(
message
,
100
,
MPI_CHARACTER
,
i
,
999
,
MPI_COMM_WORLD
,
ihandle
(
0
),
ierr
)
ENDDO
!Collect all message
DO
i
=
0
,
isize
-1
CALL
MPI_irecv
(
message_list
(
i
),
100
,
MPI_CHARACTER
,
i
,
999
,
MPI_COMM_WORLD
,
ihandle
(
i
),
ierr
)
ENDDO
!Wait for 2 seconds
CALL
priv_wait
(
2.0
)
!Check if any PE with a lower rank also reports an error
first_pe
=
.TRUE.
DO
i
=
0
,
isize
-1
CALL
MPI_TEST
(
ihandle
(
i
),
completed
,
MPI_STATUS_IGNORE
,
ierr
)
IF
(
i
<
irank
)
first_pe
=
first_pe
.AND..NOT.
completed
ENDDO
END
SUBROUTINE
collect_messages
#endif
SUBROUTINE
priv_wait
(
sec
)
!Simple routine to wait for sec-seconds
IMPLICIT
NONE
REAL
::
sec
,
t1
,
t2
CALL
cpu_TIME
(
t1
)
t2
=
t1
DO
WHILE
(
t2
-
t1
<
sec
)
CALL
cpu_TIME
(
t2
)
ENDDO
END
SUBROUTINE
priv_wait
END
MODULE
m_juDFT_stop
juDFT/sysinfo.F90
View file @
9e13b3d5
...
...
@@ -10,78 +10,103 @@
#ifndef CPP_PAGESIZE
#define CPP_PAGESIZE 4096
#endif
MODULE
m_judft_sysinfo
IMPLICIT
NONE
CONTAINS
MODULE
m_judft_sysinfo
IMPLICIT
NONE
CONTAINS
!Dump status file into out file (should be done only at end of run)
SUBROUTINE
print_memory_info
()
IMPLICIT
NONE
CHARACTER
(
LEN
=
1024
)::
line
INTEGER
::
err
,
irank
!Dump status file into out file (should be done only at end of run)
SUBROUTINE
print_memory_info
(
io
,
maxmem
)
IMPLICIT
NONE
INTEGER
,
INTENT
(
in
)
::
io
LOGICAL
,
INTENT
(
IN
),
OPTIONAL
::
maxmem
CHARACTER
(
LEN
=
1024
)::
line
INTEGER
::
err
,
irank
#ifdef CPP_MPI
INCLUDE
'mpif.h'
CALL
MPI_COMM_RANK
(
MPI_COMM_WORLD
,
irank
,
err
)
INCLUDE
'mpif.h'
CALL
MPI_COMM_RANK
(
MPI_COMM_WORLD
,
irank
,
err
)
#else
irank
=
0
irank
=
0
#endif
IF
(
irank
==
0
)
THEN
OPEN
(
99
,
FILE
=
"/proc/self/status"
,
ERR
=
999
)
DO
READ
(
99
,
"(a)"
,
ERR
=
999
,
END
=
999
)
line
WRITE
(
6
,
*
)
TRIM
(
line
)
ENDDO
999
CLOSE
(
99
,
IOSTAT
=
err
)
ELSE
WRITE
(
6
,
"(a,i0,a,a)"
)
"Rank:"
,
irank
,
" used "
,
memory_usage_string
()
END
IF
END
SUBROUTINE
print_memory_info
WRITE
(
io
,
"(a,i0,a,a)"
)
"Rank:"
,
irank
,
" used "
,
TRIM
(
memory_usage_string
(
maxmem
))
END
SUBROUTINE
print_memory_info
!Read mstat to find out current memory usage
FUNCTION
memory_usage_string
(
maxmem
)
IMPLICIT
NONE
LOGICAL
,
INTENT
(
IN
),
OPTIONAL
::
maxmem
CHARACTER
(
len
=
100
)::
memory_usage_string
INTEGER
::
fid
=
543
INTEGER
*
8
::
idum
LOGICAL
::
firstcall
=
.TRUE.
LOGICAL
::
available
=
.FALSE.
CHARACTER
(
len
=
40
)::
line
IF
(
firstcall
)
THEN
firstcall
=
.FALSE.
OPEN
(
fid
,
FILE
=
"/proc/self/statm"
,
status
=
'old'
,
action
=
'read'
,
iostat
=
idum
)
available
=
(
idum
==
0
)
ENDIF
IF
(
available
)
THEN
REWIND
(
fid
)
READ
(
fid
,
*
)
idum
WRITE
(
memory_usage_string
,
"(f8.3,a)"
)
(
CPP_PAGESIZE
/(
1024.
*
1024.
*
1024.
))
*
idum
,
"GB"
ELSE
memory_usage_string
=
""
ENDIF
!Read mstat to find out current memory usage
FUNCTION
memory_usage_string
()
IMPLICIT
NONE
CHARACTER
(
len
=
10
)::
memory_usage_string
INTEGER
::
fid
=
543
INTEGER
*
8
::
idum
LOGICAL
::
firstcall
=
.TRUE.
LOGICAL
::
available
=
.FALSE.
IF
(
firstcall
)
THEN
firstcall
=
.FALSE.
OPEN
(
fid
,
FILE
=
"/proc/self/statm"
,
status
=
'old'
,
action
=
'read'
,
iostat
=
idum
)
available
=
(
idum
==
0
)
ENDIF
IF
(
available
)
THEN
REWIND
(
fid
)
READ
(
fid
,
*
)
idum
WRITE
(
memory_usage_string
,
"(f8.3,a)"
)
(
CPP_PAGESIZE
/(
1024.
*
1024.
*
1024.
))
*
idum
,
"GB"
ELSE
memory_usage_string
=
""
ENDIF
END
FUNCTION
memory_usage_string
IF
(
PRESENT
(
maxmem
))
THEN
IF
(
maxmem
)
THEN
!Try to find maximal memory usage
OPEN
(
544
,
FILE
=
"/proc/self/status"
,
status
=
'old'
,
action
=
'read'
,
iostat
=
idum
)
IF
(
idum
==
0
)
THEN
DO
READ
(
544
,
'(a)'
,
iostat
=
idum
)
line
IF
(
idum
.NE.
0
)
EXIT
IF
(
INDEX
(
line
,
"VmPeak:"
)
>
0
)
THEN
memory_usage_string
=
TRIM
(
memory_usage_string
)//
"/"
//
TRIM
(
ADJUSTL
(
line
(
8
:)))
CLOSE
(
544
)
RETURN
ENDIF
ENDDO
CLOSE
(
544
)
END
IF
END
IF
END
IF
END
FUNCTION
memory_usage_string
SUBROUTINE
checkstack
()
CHARACTER
(
LEN
=
10
)::
l1
,
l2
,
l3
,
l4
INTEGER
::
err
LOGICAL
::
unlimited
unlimited
=
.TRUE.
!set to true by default.
!If /proc/self/limits does not exist
!or parsing fails no warning is issued
OPEN
(
99
,
FILE
=
"/proc/self/limits"
,
ERR
=
999
)
DO
READ
(
99
,
*
,
ERR
=
999
,
END
=
999
)
l1
,
l2
,
l3
,
l4
IF
(
ALL
((/
INDEX
(
l1
,
"Max"
),
INDEX
(
l2
,
"stack"
),
INDEX
(
l3
,
"size"
)/)
==
1
))
THEN
unlimited
=
INDEX
(
l4
,
"unlim"
)
==
1
ENDIF
ENDDO
999
CLOSE
(
99
,
IOSTAT
=
err
)
IF
(
.NOT.
unlimited
)
THEN
WRITE
(
*
,
*
)
"*********** WARNING! ************"
WRITE
(
*
,
*
)
"Your stacksize seems to be small"
WRITE
(
*
,
*
)
"FLEUR might crash without further"
SUBROUTINE
checkstack
()
CHARACTER
(
LEN
=
10
)::
l1
,
l2
,
l3
,
l4
INTEGER
::
err
LOGICAL
::
unlimited
#ifdef CPP_MPI
include
'mpif.h'
INTEGER
::
ierr
,
irank
#endif
unlimited
=
.TRUE.
!set to true by default.
!If /proc/self/limits does not exist
!or parsing fails no warning is issued
OPEN
(
99
,
FILE
=
"/proc/self/limits"
,
ERR
=
999
)
DO
READ
(
99
,
*
,
ERR
=
999
,
END
=
999
)
l1
,
l2
,
l3
,
l4
IF
(
ALL
((/
INDEX
(
l1
,
"Max"
),
INDEX
(
l2
,
"stack"
),
INDEX
(
l3
,
"size"
)/)
==
1
))
THEN
unlimited
=
INDEX
(
l4
,
"unlim"
)
==
1
ENDIF
ENDDO
999
CLOSE
(
99
,
IOSTAT
=
err
)
#ifdef CPP_MPI
CALL
MPI_COMM_RANK
(
MPI_COMM_WORLD
,
irank
,
ierr
)
IF
(
irank
.NE.
0
)
THEN
IF
(
.NOT.
unlimited
)
WRITE
(
*
,
*
)
"Warning, stacksize limited at PE:"
,
irank
RETURN
ENDIF
#endif
IF
(
.NOT.
unlimited
)
THEN
WRITE
(
*
,
*
)
"*********** WARNING! ************"
WRITE
(
*
,
*
)
"Your stacksize seems to be small"
WRITE
(
*
,
*
)
"FLEUR might crash without further"
WRITE
(
*
,
*
)
"notice. Try 'ulimit -s unlimited'"
WRITE
(
*
,
*
)
"*********** WARNING! ************"
ENDIF
...
...
juDFT/time.F90
View file @
9e13b3d5
...
...
@@ -26,7 +26,8 @@ MODULE m_juDFT_time
TYPE
t_timer
REAL
::
starttime
REAL
::
time
REAL
::
time
,
mintime
,
maxtime
INTEGER
::
no_calls
CHARACTER
(
LEN
=
60
)
::
name
INTEGER
::
n_subtimers
TYPE
(
t_p
),
ALLOCATABLE
::
subtimer
(:)
...
...
@@ -38,9 +39,9 @@ MODULE m_juDFT_time
CHARACTER
(
LEN
=
256
),
SAVE
::
lastfile
=
""
INTEGER
,
SAVE
::
lastline
=
0
PUBLIC
timestart
,
timestop
,
writetimes
,
write
location
,
write
TimesXML
PUBLIC
timestart
,
timestop
,
writetimes
,
writeTimesXML
PUBLIC
resetIterationDependentTimers
,
check_time_for_next_iteration
PUBLIC
juDFT_time_lastlocation
!should
not be used
PUBLIC
juDFT_time_lastlocation
!should
be used for error handling only
CONTAINS
...
...
@@ -49,9 +50,6 @@ CONTAINS
SUBROUTINE
priv_new_timer
(
name
)
IMPLICIT
NONE
CHARACTER
(
LEN
=*
),
INTENT
(
IN
)
::
name
TYPE
(
t_timer
),
POINTER
::
t
TYPE
(
t_p
),
ALLOCATABLE
::
tmp
(:)
...
...
@@ -59,6 +57,9 @@ CONTAINS
ALLOCATE
(
t
)
t
%
starttime
=
cputime
()
t
%
time
=
0.0
t
%
mintime
=
1E99
t
%
maxtime
=
0.0
t
%
no_calls
=
0
t
%
name
=
name
t
%
n_subtimers
=
0
t
%
parenttimer
=>
null
()
...
...
@@ -131,6 +132,8 @@ CONTAINS
SUBROUTINE
timestop
(
ttimer
)
CHARACTER
(
LEN
=*
),
INTENT
(
IN
)
::
ttimer
REAL
::
time
IF
(
.NOT.
TRIM
(
ttimer
)
==
TRIM
(
current_timer
%
name
))
THEN
WRITE
(
*
,
*
)
"Current timer:"
,
current_timer
%
name
,
" could not stop:"
,
ttimer
STOP
"BUG:timestop"
...
...
@@ -139,7 +142,11 @@ CONTAINS
WRITE
(
*
,
*
)
"Timer not initialized:"
//
ttimer
STOP
"BUG:timestop"
ENDIF
current_timer
%
time
=
current_timer
%
time
+
cputime
()
-
current_timer
%
starttime
time
=
cputime
()
-
current_timer
%
starttime
!This runtime
current_timer
%
time
=
current_timer
%
time
+
time
current_timer
%
no_calls
=
current_timer
%
no_calls
+1
current_timer
%
mintime
=
MIN
(
current_timer
%
mintime
,
time
)
current_timer
%
maxtime
=
MAX
(
current_timer
%
maxtime
,
time
)
current_timer
%
starttime
=
-1
CALL
priv_debug_output
(
" stopped "
,
current_timer
%
name
)
...
...
@@ -168,7 +175,7 @@ CONTAINS
RECURSIVE
SUBROUTINE
priv_writetimes_longest
(
timer
,
fid
,
timernames
,
timertimes
)
IMPLICIT
NONE
TYPE
(
t_timer
),
INTENT
(
IN
)
::
timer
TYPE
(
t_timer
),
INTENT
(
IN
)
::
timer
INTEGER
,
INTENT
(
IN
),
OPTIONAL
::
fid
CHARACTER
(
LEN
=
60
),
INTENT
(
INOUT
),
OPTIONAL
::
timernames
(
10
)
REAL
,
INTENT
(
INOUT
),
OPTIONAL
::
timertimes
(
10
)
...
...
@@ -236,8 +243,12 @@ CONTAINS
time
=
timer
%
time
timername
=
timer
%
name
ENDIF
IF
(
time
<
min_time
*
globaltimer
%
time
)
RETURN
!do not print parts that take less than min_time
WRITE
(
fid
,
"(a,T7,a,T46,a)"
)
TRIM
(
indentstring
),
TRIM
(
timername
),
timestring
(
time
,
globaltimer
%
time
,
level
)
IF
(
time
<
min_time
*
globaltimer
%
time
)
RETURN
!do not print parts that take less than min_time of the totaltime
IF
(
timer
%
no_calls
>
1
)
THEN
WRITE
(
fid
,
"(a,T7,a,T46,a,T85,a,i0,a,f9.0,a,f9.0,a)"
)
TRIM
(
indentstring
),
TRIM
(
timername
),
TRIM
(
timestring
(
time
,
globaltimer
%
time
,
level
)),
"("
,
timer
%
no_calls
,
"calls:"
,
timer
%
mintime
,
"sec -"
,
timer
%
maxtime
,
"sec)"
ELSE
WRITE
(
fid
,
"(a,T7,a,T46,a)"
)
TRIM
(
indentstring
),
TRIM
(
timername
),
timestring
(
time
,
globaltimer
%
time
,
level
)
END
IF
FLUSH
(
fid
)
IF
(
PRESENT
(
debug
)
.OR.
timer
%
n_subtimers
==
0
)
RETURN
...
...
@@ -245,7 +256,7 @@ CONTAINS
DO
n
=
1
,
timer
%
n_subtimers
time
=
time
+
timer
%
subtimer
(
n
)
%
p
%
time
ENDDO
WRITE
(
fid
,
"(a,a,T46,
a)"
)
TRIM
(
indentstring
),
" measured in submodules:"
,
timestring
(
time
,
-.1
,
level
)
WRITE
(
fid
,
"(a,a,T46,
3a)"
)
TRIM
(
indentstring
),
" measured in submodules:"
,
TRIM
(
timestring
(
time
,
-.1
,
level
)
)
FLUSH
(
fid
)
DO
n
=
1
,
timer
%
n_subtimers
CALL
priv_writetimes
(
timer
%
subtimer
(
n
)
%
p
,
level
+1
,
fid
)
...
...
@@ -263,7 +274,7 @@ CONTAINS
IF
(
.NOT.
PRESENT
(
location
))
THEN
IF
(
ASSOCIATED
(
current_timer
))
CALL
writelocation
(
current_timer
)
ELSE
WRITE
(
*
,
*
)
"Timer:"
,
location
%
name
WRITE
(
0
,
*
)
"Timer:"
,
location
%
name
IF
(
ASSOCIATED
(
location
%
parenttimer
))
CALL
writelocation
(
location
%
parenttimer
)
ENDIF
END
SUBROUTINE
writelocation
...
...
@@ -292,11 +303,7 @@ CONTAINS
fn
=
2
OPEN
(
2
,
FILE
=
'juDFT_times'
,
STATUS
=
"replace"
)
ENDIF
!Stop globaltimer if still running
IF
(
globaltimer
%
starttime
>
-1
)
THEN
globaltimer
%
time
=
cputime
()
-
globaltimer
%
starttime
globaltimer
%
starttime
=
-1
ENDIF
globaltimer
%
time
=
cputime
()
-
globaltimer
%
starttime
WRITE
(
fn
,
"('Total execution time: ',i0,'sec')"
)
INT
(
globaltimer
%
time
)
CALL
add_usage_data
(
"Runtime"
,
globaltimer
%
time
)
CALL
priv_writetimes_longest
(
globaltimer
,
fid
=
fn
)
...
...
@@ -515,22 +522,17 @@ CONTAINS
! .. Local Scalars ..
REAL
::
rest
,
seconds
INTEGER
::
ihours
,
iminutes
CHARACTER
(
LEN
=
90
)::
formatstring
rest
=
time
rest
=
time
ihours
=
INT
(
rest
/
3600.0
)
rest
=
rest
-
REAL
(
ihours
)
*
3600
iminutes
=
INT
(
rest
/
60.0
)
seconds
=
rest
-
REAL
(
iminutes
)
*
60
IF
(
ttime
<
0
)
THEN
formatstring
=
"(f9.2,'sec = ',i3,'h ',i2,'min ',i2,'sec')"
WRITE
(
timestring
,
FMT
=
formatstring
)
time
,
ihours
,
iminutes
,
INT
(
seconds
)
WRITE
(
timestring
,
"(f9.2,'sec= ',i3,'h ',i2,'min ',i2,'sec')"
)
time
,
ihours
,
iminutes
,
INT
(
seconds
)
ELSE
WRITE
(
formatstring
,
"(a,i0,a)"
)
"(f9.2,'sec= ',i3,'h ',i2,'min ',i2,'sec ->',"
,(
2
*
level
-1
),
"x,f5.1,'%')"
WRITE
(
timestring
,
FMT
=
formatstring
)
time
,
ihours
,
iminutes
,
INT
(
seconds
),
time
/
ttime
*
100.0
WRITE
(
timestring
,
"(f9.2,'sec= ',i3,'h ',i2,'min ',i2,'sec ->',1x,f5.1,'%')"
)
time
,
ihours
,
iminutes
,
INT
(
seconds
),
time
/
ttime
*
100.0
ENDIF
END
FUNCTION
timestring
!>
...
...
@@ -560,13 +562,19 @@ CONTAINS
#endif
END
FUNCTION
cputime
!>
SUBROUTINE
juDFT_time_lastlocation
(
PE
)
CHARACTER
(
LEN
=
4
),
INTENT
(
IN
)::
PE
IF
(
lastline
>
0
)
THEN
WRITE
(
0
,
*
)
PE
,
"Last kown location:"
WRITE
(
0
,
*
)
PE
,
"File:"
,
TRIM
(
lastfile
),
":"
,
lastline
WRITE
(
0
,
*
)
PE
,
"*****************************************"
ENDIF
SUBROUTINE
juDFT_time_lastlocation
()
IF
(
ASSOCIATED
(
current_timer
))
THEN
WRITE
(
0
,
*
)
"Last kown location:"
WRITE
(
0
,
*
)
"Last timer:"
,
current_timer
%
name
IF
(
lastline
>
0
)
THEN
WRITE
(
0
,
*
)
"File:"
,
TRIM
(
lastfile
),
":"
,
lastline
ENDIF
IF
(
ASSOCIATED
(
current_timer
%
parenttimer
))
THEN
WRITE
(
0
,
*
)
"Timerstack:"
CALL
writelocation
(
current_timer
%
parenttimer
)
ENDIF
WRITE
(
0
,
*
)
"*****************************************"
END
IF
END
SUBROUTINE
juDFT_time_lastlocation
END
MODULE
m_juDFT_time
main/fleur_job.F90
View file @
9e13b3d5
...
...
@@ -136,6 +136,7 @@ CONTAINS
INCLUDE
'mpif.h'
INTEGER
ierr
(
3
)
CALL
MPI_INIT_THREAD
(
MPI_THREAD_SERIALIZED
,
i
,
ierr
)
CALL
judft_init
()
CALL
MPI_COMM_RANK
(
MPI_COMM_WORLD
,
irank
,
ierr
)
IF
(
irank
.EQ.
0
)
THEN
!$ IF (i<MPI_THREAD_SERIALIZED) THEN
...
...
@@ -249,7 +250,6 @@ PROGRAM fleurjob
USE
m_juDFT
IMPLICIT
NONE
TYPE
(
t_job
),
ALLOCATABLE
::
jobs
(:)