Commit 9e13b3d5 authored by Daniel Wortmann's avatar Daniel Wortmann

Some work on juDFT subroutines to beautify them

parent b03d6d9f
...@@ -49,18 +49,18 @@ ...@@ -49,18 +49,18 @@
INTEGER:: irank,ierr INTEGER:: irank,ierr
CALL MPI_COMM_RANK (MPI_COMM_WORLD,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 #else
WRITE(*,*) "Signal detected:",signal WRITE(0,*) "Signal detected:",signal
#endif #endif
WRITE(*,*) "This might be due to either:" WRITE(0,*) "This might be due to either:"
WRITE(*,*) " - A bug in FLEUR" WRITE(0,*) " - A bug"
WRITE(*,*) " - Your job running out of memory" WRITE(0,*) " - Your job running out of memory"
WRITE(*,*) " - Your job got killed externally (e.g. no cpu-time left)" WRITE(0,*) " - Your job got killed externally (e.g. no cpu-time left)"
WRITE(*,*) " - ...." WRITE(0,*) " - ...."
WRITE(*,*) "Please check and report if you believe you found a bug" WRITE(0,*) "Please check and report if you believe you found a bug"
CALL writetimes() CALL writetimes()
CALL PRINT_memory_info() CALL PRINT_memory_info(0,.true.)
#ifdef CPP_MPI #ifdef CPP_MPI
CALL MPI_ABORT(MPI_COMM_WORLD,ierr) CALL MPI_ABORT(MPI_COMM_WORLD,ierr)
#endif #endif
......
...@@ -45,11 +45,12 @@ CONTAINS ...@@ -45,11 +45,12 @@ CONTAINS
LOGICAL :: l_exist LOGICAL :: l_exist
INQUIRE(file=filename,exist=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 END SUBROUTINE judfT_file_readable
SUBROUTINE juDFT_error(message,calledby,hint,no,warning,file,line) SUBROUTINE juDFT_error(message,calledby,hint,no,warning,file,line)
USE m_judft_usage USE m_judft_usage
USE m_xmloutput
IMPLICIT NONE IMPLICIT NONE
CHARACTER*(*),INTENT(IN) :: message CHARACTER*(*),INTENT(IN) :: message
CHARACTER*(*),OPTIONAL,INTENT(IN) :: calledby,hint CHARACTER*(*),OPTIONAL,INTENT(IN) :: calledby,hint
...@@ -58,18 +59,18 @@ CONTAINS ...@@ -58,18 +59,18 @@ CONTAINS
CHARACTER*(*),OPTIONAL,INTENT(IN) :: file CHARACTER*(*),OPTIONAL,INTENT(IN) :: file
INTEGER,INTENT(IN),OPTIONAL :: line INTEGER,INTENT(IN),OPTIONAL :: line
LOGICAL :: callstop,warn LOGICAL :: callstop,warn,first_pe
CHARACTER(LEN=4)::PE INTEGER :: isize,irank,e,i
!store all output in variable for single call to write in MPI case CHARACTER(len=100),ALLOCATABLE::message_list(:)
CHARACTER(len=300)::text(10)
INTEGER ::linenr,n
#ifdef CPP_MPI #ifdef CPP_MPI
include 'mpif.h' include 'mpif.h'
INTEGER :: irank,e LOGICAL :: first_parallel
CALL MPI_COMM_RANK(MPI_COMM_WORLD,irank,e) CALL MPI_COMM_RANK(MPI_COMM_WORLD,irank,e)
WRITE(PE,"(i4)") irank CALL MPI_COMM_SIZE(MPI_COMM_WORLD,isize,e)
#else #else
PE=" ****" first_pe=.TRUE.
isize=1
irank=0
#endif #endif
warn = .FALSE. warn = .FALSE.
IF (PRESENT(warning)) warn = warning IF (PRESENT(warning)) warn = warning
...@@ -79,60 +80,83 @@ CONTAINS ...@@ -79,60 +80,83 @@ CONTAINS
callstop=.false. callstop=.false.
ELSE ELSE
INQUIRE(FILE ="JUDFT_WARN_ONLY",EXIST= callstop) INQUIRE(FILE ="JUDFT_WARN_ONLY",EXIST= callstop)
callstop = .NOT.callstop callstop = .NOT.callstop
ENDIF ENDIF
ELSE ELSE
callstop = .TRUE. callstop = .TRUE.
ENDIF ENDIF
IF (.NOT.warn) THEN #ifdef CPP_MPI
WRITE(text(1),*) PE,"**************juDFT-Error*****************" CALL collect_messages(message,message_list,first_pe)
ELSE #endif
WRITE(text(1),*) PE,"************juDFT-Warning*****************"
ENDIF IF (first_pe) THEN
WRITE(text(2),"(3a)") PE,"Error message:",message IF (.NOT.warn) THEN
linenr=3 WRITE(0,'(a)') "**************juDFT-Error*****************"
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
ELSE 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 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 ENDIF
WRITE(text(linenr),*) PE,"*****************************************"
if (.not.warn) CALL juDFT_time_lastlocation(PE)
IF (callstop) THEN 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) CALL add_usage_data("Error",message)
!$OMP MASTER !$OMP MASTER
CALL send_usage_data() CALL send_usage_data()
!$OMP END MASTER !$OMP END MASTER
CALL juDFT_STOP() CALL juDFT_STOP()
ENDIF ENDIF
WRITE(0,*)
write(0,"(10(a,/))") (trim(text(n)),n=1,linenr)
END SUBROUTINE juDFT_error END SUBROUTINE juDFT_error
SUBROUTINE juDFT_warn(message,calledby,hint,no,file,line) SUBROUTINE juDFT_warn(message,calledby,hint,no,file,line)
...@@ -184,7 +208,7 @@ CONTAINS ...@@ -184,7 +208,7 @@ CONTAINS
WRITE(0,*) " ",message WRITE(0,*) " ",message
WRITE(0,*) "*****************************************" WRITE(0,*) "*****************************************"
CALL writetimes() CALL writetimes()
CALL print_memory_info() CALL print_memory_info(0,.true.)
CALL send_usage_data() CALL send_usage_data()
#ifdef CPP_MPI #ifdef CPP_MPI
IF(PRESENT(irank)) THEN IF(PRESENT(irank)) THEN
...@@ -209,7 +233,7 @@ CONTAINS ...@@ -209,7 +233,7 @@ CONTAINS
INTEGER, OPTIONAL, INTENT(IN) :: errorCode INTEGER, OPTIONAL, INTENT(IN) :: errorCode
INTEGER :: error INTEGER :: error
LOGICAL :: calltrace LOGICAL :: calltrace
LOGICAL,ALLOCATABLE:: a(:) LOGICAL,ALLOCATABLE::a(:)
#ifdef CPP_MPI #ifdef CPP_MPI
INTEGER :: ierr INTEGER :: ierr
#endif #endif
...@@ -218,10 +242,7 @@ CONTAINS ...@@ -218,10 +242,7 @@ CONTAINS
IF(PRESENT(errorCode)) THEN IF(PRESENT(errorCode)) THEN
error = errorCode error = errorCode
END IF END IF
!try to print times !Now try to generate a stack-trace if requested
call writelocation()
CALL writetimes(.TRUE.)
CALL print_memory_info()
INQUIRE(FILE="JUDFT_TRACE",EXIST=calltrace) INQUIRE(FILE="JUDFT_TRACE",EXIST=calltrace)
IF (judft_was_argument("-trace")) calltrace=.TRUE. IF (judft_was_argument("-trace")) calltrace=.TRUE.
IF (error.EQ.1) calltrace = .TRUE. IF (error.EQ.1) calltrace = .TRUE.
...@@ -248,6 +269,59 @@ CONTAINS ...@@ -248,6 +269,59 @@ CONTAINS
END SUBROUTINE juDFT_stop 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 END MODULE m_juDFT_stop
...@@ -10,78 +10,103 @@ ...@@ -10,78 +10,103 @@
#ifndef CPP_PAGESIZE #ifndef CPP_PAGESIZE
#define CPP_PAGESIZE 4096 #define CPP_PAGESIZE 4096
#endif #endif
MODULE m_judft_sysinfo MODULE m_judft_sysinfo
IMPLICIT NONE IMPLICIT NONE
CONTAINS CONTAINS
!Dump status file into out file (should be done only at end of run) !Dump status file into out file (should be done only at end of run)
SUBROUTINE print_memory_info() SUBROUTINE print_memory_info(io,maxmem)
IMPLICIT NONE IMPLICIT NONE
CHARACTER(LEN=1024):: line INTEGER,INTENT(in) :: io
INTEGER :: err,irank LOGICAL,INTENT(IN),OPTIONAL :: maxmem
CHARACTER(LEN=1024):: line
INTEGER :: err,irank
#ifdef CPP_MPI #ifdef CPP_MPI
INCLUDE 'mpif.h' INCLUDE 'mpif.h'
CALL MPI_COMM_RANK(MPI_COMM_WORLD,irank,err) CALL MPI_COMM_RANK(MPI_COMM_WORLD,irank,err)
#else #else
irank=0 irank=0
#endif #endif
IF (irank==0) THEN WRITE(io,"(a,i0,a,a)") "Rank:",irank," used ",TRIM(memory_usage_string(maxmem))
OPEN(99,FILE="/proc/self/status",ERR=999) END SUBROUTINE print_memory_info
DO
READ(99,"(a)",ERR=999,END=999) line !Read mstat to find out current memory usage
WRITE(6,*) TRIM(line) FUNCTION memory_usage_string(maxmem)
ENDDO IMPLICIT NONE
999 CLOSE(99,IOSTAT=err) LOGICAL,INTENT(IN),OPTIONAL :: maxmem
ELSE CHARACTER(len=100):: memory_usage_string
WRITE(6,"(a,i0,a,a)") "Rank:",irank," used ",memory_usage_string() INTEGER:: fid=543
END IF INTEGER*8:: idum
END SUBROUTINE print_memory_info 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 IF (PRESENT(maxmem)) THEN
FUNCTION memory_usage_string() IF (maxmem) THEN
IMPLICIT NONE !Try to find maximal memory usage
CHARACTER(len=10):: memory_usage_string OPEN(544,FILE="/proc/self/status",status='old',action='read',iostat=idum)
INTEGER:: fid=543 IF (idum==0) THEN
INTEGER*8:: idum DO
LOGICAL:: firstcall=.TRUE. READ(544,'(a)',iostat=idum) line
LOGICAL:: available=.FALSE. IF (idum.NE.0) EXIT
IF (INDEX(line,"VmPeak:")>0) THEN
IF (firstcall) THEN memory_usage_string=TRIM(memory_usage_string)//"/"//TRIM(ADJUSTL(line(8:)))
firstcall=.FALSE. CLOSE(544)
OPEN(fid,FILE="/proc/self/statm",status='old',action='read',iostat=idum) RETURN
available=(idum==0) ENDIF
ENDIF ENDDO
IF (available) THEN CLOSE(544)
REWIND(fid) END IF
READ(fid,*) idum END IF
WRITE(memory_usage_string,"(f8.3,a)") (CPP_PAGESIZE/(1024.*1024.*1024.))*idum,"GB" END IF
ELSE END FUNCTION memory_usage_string
memory_usage_string=""
ENDIF
END FUNCTION memory_usage_string
SUBROUTINE checkstack() SUBROUTINE checkstack()
CHARACTER(LEN=10):: l1,l2,l3,l4 CHARACTER(LEN=10):: l1,l2,l3,l4
INTEGER :: err INTEGER :: err
LOGICAL :: unlimited LOGICAL :: unlimited
unlimited=.TRUE. !set to true by default. #ifdef CPP_MPI
!If /proc/self/limits does not exist include 'mpif.h'
!or parsing fails no warning is issued INTEGER:: ierr,irank
OPEN(99,FILE="/proc/self/limits",ERR=999) #endif
DO unlimited=.TRUE. !set to true by default.
READ(99,*,ERR=999,END=999) l1,l2,l3,l4 !If /proc/self/limits does not exist
IF (ALL((/INDEX(l1,"Max"),INDEX(l2,"stack"),INDEX(l3,"size")/)==1)) THEN !or parsing fails no warning is issued
unlimited=INDEX(l4,"unlim")==1 OPEN(99,FILE="/proc/self/limits",ERR=999)
ENDIF DO
ENDDO READ(99,*,ERR=999,END=999) l1,l2,l3,l4
999 CLOSE(99,IOSTAT=err) IF (ALL((/INDEX(l1,"Max"),INDEX(l2,"stack"),INDEX(l3,"size")/)==1)) THEN
IF (.NOT.unlimited) THEN unlimited=INDEX(l4,"unlim")==1
WRITE(*,*) "*********** WARNING! ************" ENDIF
WRITE(*,*) "Your stacksize seems to be small" ENDDO
WRITE(*,*) "FLEUR might crash without further" 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(*,*) "notice. Try 'ulimit -s unlimited'"
WRITE(*,*) "*********** WARNING! ************" WRITE(*,*) "*********** WARNING! ************"
ENDIF ENDIF
......
...@@ -26,7 +26,8 @@ MODULE m_juDFT_time ...@@ -26,7 +26,8 @@ MODULE m_juDFT_time
TYPE t_timer TYPE t_timer
REAL :: starttime REAL :: starttime
REAL :: time REAL :: time,mintime,maxtime
INTEGER :: no_calls
CHARACTER(LEN=60) :: name CHARACTER(LEN=60) :: name
INTEGER :: n_subtimers INTEGER :: n_subtimers
TYPE(t_p),ALLOCATABLE :: subtimer(:) TYPE(t_p),ALLOCATABLE :: subtimer(:)
...@@ -38,9 +39,9 @@ MODULE m_juDFT_time ...@@ -38,9 +39,9 @@ MODULE m_juDFT_time
CHARACTER(LEN=256),SAVE :: lastfile="" CHARACTER(LEN=256),SAVE :: lastfile=""
INTEGER ,SAVE :: lastline=0 INTEGER ,SAVE :: lastline=0
PUBLIC timestart,timestop,writetimes,writelocation,writeTimesXML PUBLIC timestart,timestop,writetimes,writeTimesXML
PUBLIC resetIterationDependentTimers,check_time_for_next_iteration 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 CONTAINS
...@@ -49,9 +50,6 @@ CONTAINS ...@@ -49,9 +50,6 @@ CONTAINS
SUBROUTINE priv_new_timer(name) SUBROUTINE priv_new_timer(name)
IMPLICIT NONE IMPLICIT NONE
CHARACTER(LEN=*),INTENT(IN) ::name CHARACTER(LEN=*),INTENT(IN) ::name
TYPE(t_timer),POINTER ::t TYPE(t_timer),POINTER ::t
TYPE(t_p),ALLOCATABLE :: tmp(:) TYPE(t_p),ALLOCATABLE :: tmp(:)
...@@ -59,6 +57,9 @@ CONTAINS ...@@ -59,6 +57,9 @@ CONTAINS
ALLOCATE(t) ALLOCATE(t)
t%starttime=cputime() t%starttime=cputime()
t%time=0.0 t%time=0.0
t%mintime=1E99
t%maxtime=0.0
t%no_calls=0
t%name=name t%name=name
t%n_subtimers=0 t%n_subtimers=0
t%parenttimer=>null() t%parenttimer=>null()
...@@ -131,6 +132,8 @@ CONTAINS ...@@ -131,6 +132,8 @@ CONTAINS
SUBROUTINE timestop(ttimer) SUBROUTINE timestop(ttimer)
CHARACTER(LEN =*),INTENT(IN) :: ttimer CHARACTER(LEN =*),INTENT(IN) :: ttimer
REAL::time
IF (.NOT.TRIM(ttimer)==TRIM(current_timer%name)) THEN IF (.NOT.TRIM(ttimer)==TRIM(current_timer%name)) THEN
WRITE(*,*)"Current timer:",current_timer%name," could not stop:",ttimer WRITE(*,*)"Current timer:",current_timer%name," could not stop:",ttimer
STOP "BUG:timestop" STOP "BUG:timestop"
...@@ -139,7 +142,11 @@ CONTAINS ...@@ -139,7 +142,11 @@ CONTAINS
WRITE(*,*) "Timer not initialized:"//ttimer WRITE(*,*) "Timer not initialized:"//ttimer
STOP "BUG:timestop" STOP "BUG:timestop"
ENDIF 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 current_timer%starttime=-1
CALL priv_debug_output(" stopped ",current_timer%name) CALL priv_debug_output(" stopped ",current_timer%name)
...@@ -168,7 +175,7 @@ CONTAINS ...@@ -168,7 +175,7 @@ CONTAINS
RECURSIVE SUBROUTINE priv_writetimes_longest(timer,fid,timernames,timertimes) RECURSIVE SUBROUTINE priv_writetimes_longest(timer,fid,timernames,timertimes)
IMPLICIT NONE IMPLICIT NONE
TYPE(t_timer),INTENT(IN) :: timer TYPE(t_timer),INTENT(IN) :: timer
INTEGER,INTENT(IN),OPTIONAL :: fid INTEGER,INTENT(IN),OPTIONAL :: fid
CHARACTER(LEN=60),INTENT(INOUT),OPTIONAL ::timernames(10) CHARACTER(LEN=60),INTENT(INOUT),OPTIONAL ::timernames(10)
REAL,INTENT(INOUT),OPTIONAL ::timertimes(10) REAL,INTENT(INOUT),OPTIONAL ::timertimes(10)
...@@ -236,8 +243,12 @@ CONTAINS ...@@ -236,8 +243,12 @@ CONTAINS
time=timer%time time=timer%time
timername=timer%name timername=timer%name
ENDIF ENDIF
IF (time<min_time*globaltimer%time) RETURN !do not print parts that take less than min_time IF (time<min_time*globaltimer%time) RETURN !do not print parts that take less than min_time of the totaltime
WRITE(fid,"(a,T7,a,T46,a)") TRIM(indentstring),TRIM(timername),timestring(time,globaltimer%time,level) 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) FLUSH(fid)
IF (PRESENT(debug).OR.timer%n_subtimers==0) RETURN IF (PRESENT(debug).OR.timer%n_subtimers==0) RETURN
...@@ -245,7 +256,7 @@ CONTAINS ...@@ -245,7 +256,7 @@ CONTAINS
DO n=1,timer%n_subtimers DO n=1,timer%n_subtimers
time=time+timer%subtimer(n)%p%time time=time+timer%subtimer(n)%p%time
ENDDO 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) FLUSH(fid)
DO n=1,timer%n_subtimers DO n=1,timer%n_subtimers
CALL priv_writetimes(timer%subtimer(n)%p,level+1,fid) CALL priv_writetimes(timer%subtimer(n)%p,level+1,fid)
...@@ -263,7 +274,7 @@ CONTAINS ...@@ -263,7 +274,7 @@ CONTAINS
IF (.NOT.PRESENT(location)) THEN IF (.NOT.PRESENT(location)) THEN
IF (ASSOCIATED(current_timer)) CALL writelocation(current_timer) IF (ASSOCIATED(current_timer)) CALL writelocation(current_timer)
ELSE ELSE
WRITE(*,*) "Timer:",location%name WRITE(0,*) "Timer:",location%name
IF (ASSOCIATED(location%parenttimer)) CALL writelocation(location%parenttimer) IF (ASSOCIATED(location%parenttimer)) CALL writelocation(location%parenttimer)
ENDIF ENDIF
END SUBROUTINE writelocation END SUBROUTINE writelocation
...@@ -292,11 +303,7 @@ CONTAINS ...@@ -292,11 +303,7 @@ CONTAINS
fn=2 fn=2
OPEN(2,FILE ='juDFT_times',STATUS="replace") OPEN(2,FILE ='juDFT_times',STATUS="replace")
ENDIF ENDIF
!Stop globaltimer if still running globaltimer%time=cputime()-globaltimer%starttime
IF (globaltimer%starttime>-1) THEN
globaltimer%time=cputime()-globaltimer%starttime
globaltimer%starttime=-1
ENDIF
WRITE(fn,"('Total execution time: ',i0,'sec')") INT(globaltimer%time) WRITE(fn,"('Total execution time: ',i0,'sec')") INT(globaltimer%time)
CALL add_usage_data("Runtime",globaltimer%time) CALL add_usage_data("Runtime",globaltimer%time)
CALL priv_writetimes_longest(globaltimer,fid=fn) CALL priv_writetimes_longest(globaltimer,fid=fn)
...@@ -515,22 +522,17 @@ CONTAINS ...@@ -515,22 +522,17 @@ CONTAINS
! .. Local Scalars .. ! .. Local Scalars ..
REAL :: rest,seconds REAL :: rest,seconds
INTEGER :: ihours,iminutes INTEGER :: ihours,iminutes
CHARACTER(LEN=90)::formatstring
rest = time
rest = time
ihours = INT(rest/3600.0) ihours = INT(rest/3600.0)
rest = rest - REAL(ihours)*3600 rest = rest - REAL(ihours)*3600
iminutes = INT(rest/60.0) iminutes = INT(rest/60.0)
seconds = rest - REAL(iminutes)*60 seconds = rest - REAL(iminutes)*60
IF (ttime<0) THEN IF (ttime<0) THEN
formatstring="(f9.2,'sec = ',i3,'h ',i2,'min ',i2,'sec')" WRITE (timestring,"(f9.2,'sec= ',i3,'h ',i2,'min ',i2,'sec')") time,ihours,iminutes,INT(seconds)
WRITE (timestring,FMT = formatstring) time,ihours,iminutes,INT(seconds)
ELSE ELSE
WRITE(formatstring,"(a,i0,a)") "(f9.2,'sec= ',i3,'h ',i2,'min ',i2,'sec ->',",(2*level-1),"x,f5.1,'%')" WRITE (timestring,"(f9.2,'sec= ',i3,'h ',i2,'min ',i2,'sec ->',1x,f5.1,'%')") time,ihours,iminutes,INT(seconds),time/ttime*100.0
WRITE (timestring,FMT = formatstring) time,ihours,iminutes,INT(seconds),time/ttime*100.0
ENDIF ENDIF
END FUNCTION timestring END FUNCTION timestring
!> !>
...@@ -560,13 +562,19 @@ CONTAINS ...@@ -560,13 +562,19 @@ CONTAINS
#endif #endif
END FUNCTION cputime END FUNCTION cputime
!> !>
SUBROUTINE juDFT_time_lastlocation(PE) SUBROUTINE juDFT_time_lastlocation()
CHARACTER(LEN=4),INTENT(IN):: PE IF (ASSOCIATED(current_timer)) THEN
IF (lastline>0) THEN WRITE(0,*) "Last kown location:"
WRITE(0,*) PE,"Last kown location:" WRITE(0,*) "Last timer:",current_timer%name