Added functionality to measure memory footprint for -debugtime option

diagonalization/chani.F90

@@ -30,7 +30,7 @@ CONTAINS
     !
     !----------------------------------------------------
     !
-!#include"cpp_arch.h"
+    !#include"cpp_arch.h"
 #include"cpp_double.h"
     USE m_juDFT
     USE m_types
@@ -45,7 +45,7 @@ CONTAINS
     REAL,    INTENT   (OUT) :: eig(neigd)
     TYPE(t_hamOvlp),INTENT(INOUT) :: hamOvlp
     TYPE(t_zMat),INTENT(INOUT)    :: zMat
- 
+
     !...  Local variables
     !
     INTEGER nc,ic,ir,n_sym,jsym,num_j,icm,n_bound
@@ -79,7 +79,7 @@ CONTAINS
     EXTERNAL CPP_LAPACK_slamch, descinit
     EXTERNAL blacs_pinfo, blacs_gridinit
     EXTERNAL MPI_COMM_DUP
-    
+
     !
     ! determine actual number of columns of input matrices A and B
     ! nc is number of columns the local processor will get, must be <=n
@@ -293,52 +293,52 @@ CONTAINS
     !     Compute size of workspace
     !
     if (hamovlp%l_real) THEN
-    uplo='U'
-    CALL CPP_LAPACK_pdsygvx(1,'V','I','U',m,asca_r,1,1,desca,bsca_r,1,1, desca,&
-         0.0,1.0,1,num,abstol,num1,num2,eig2,orfac,eigvec_r,1,1,&
-         desceigv,work2_r,-1,iwork,-1,ifail,iclustr, gap,ierr)
-    IF ( work2_r(1).GT.lwork2) THEN
-       lwork2 = work2_r(1)
-       DEALLOCATE (work2_r)
-       ALLOCATE ( work2_r(lwork2+20*m), stat=err ) ! Allocate even more in case of clusters
-       IF (err.NE.0) THEN
-          WRITE (*,*) 'work2  :',err,lwork2
-          CALL juDFT_error('Failed to allocated "work2"', calledby ='chani')
-       ENDIF
-    ENDIF
-else
-    lrwork=4*m+MAX(5*nn,np0*mq0)+ iceil(neigd,nprow*npcol)*nn
-    ! Allocate more in case of clusters
-    ALLOCATE(rwork(lrwork+10*m), stat=ierr)
-    IF (err /= 0) THEN
-       WRITE (*,*) 'ERROR: chani.F: Allocating rwork failed'
-       CALL juDFT_error('Failed to allocated "rwork"', calledby ='chani')
-    ENDIF
-
-    CALL CPP_LAPACK_pzhegvx(1,'V','I','U',m,asca_c,1,1,desca,bsca_c,1,1, desca,&
-         0.0,1.0,1,num,abstol,num1,num2,eig2,orfac,eigvec_c,1,1,&
-         desceigv,work2_c,-1,rwork,-1,iwork,-1,ifail,iclustr,&
-         gap,ierr)
-    IF (ABS(work2_c(1)).GT.lwork2) THEN
-       lwork2=work2_c(1)
-       DEALLOCATE (work2_c)
-       ALLOCATE (work2_c(lwork2), stat=err)
-       IF (err /= 0) THEN
-          WRITE (*,*) 'ERROR: chani.F: Allocating rwork failed:',lwork2
-          CALL juDFT_error('Failed to allocated "work2"', calledby ='chani')
+       uplo='U'
+       CALL CPP_LAPACK_pdsygvx(1,'V','I','U',m,asca_r,1,1,desca,bsca_r,1,1, desca,&
+            0.0,1.0,1,num,abstol,num1,num2,eig2,orfac,eigvec_r,1,1,&
+            desceigv,work2_r,-1,iwork,-1,ifail,iclustr, gap,ierr)
+       IF ( work2_r(1).GT.lwork2) THEN
+          lwork2 = work2_r(1)
+          DEALLOCATE (work2_r)
+          ALLOCATE ( work2_r(lwork2+20*m), stat=err ) ! Allocate even more in case of clusters
+          IF (err.NE.0) THEN
+             WRITE (*,*) 'work2  :',err,lwork2
+             CALL juDFT_error('Failed to allocated "work2"', calledby ='chani')
+          ENDIF
        ENDIF
-    ENDIF
-    IF (rwork(1).GT.lrwork) THEN
-       lrwork=rwork(1)
-       DEALLOCATE(rwork)
-       ! Allocate even more in case of clusters
-       ALLOCATE (rwork(lrwork+20*m), stat=err)
+    else
+       lrwork=4*m+MAX(5*nn,np0*mq0)+ iceil(neigd,nprow*npcol)*nn
+       ! Allocate more in case of clusters
+       ALLOCATE(rwork(lrwork+10*m), stat=ierr)
        IF (err /= 0) THEN
-          WRITE (*,*) 'ERROR: chani.F: Allocating rwork failed: ', lrwork+20*m
+          WRITE (*,*) 'ERROR: chani.F: Allocating rwork failed'
           CALL juDFT_error('Failed to allocated "rwork"', calledby ='chani')
        ENDIF
-    ENDIF
-endif
+
+       CALL CPP_LAPACK_pzhegvx(1,'V','I','U',m,asca_c,1,1,desca,bsca_c,1,1, desca,&
+            0.0,1.0,1,num,abstol,num1,num2,eig2,orfac,eigvec_c,1,1,&
+            desceigv,work2_c,-1,rwork,-1,iwork,-1,ifail,iclustr,&
+            gap,ierr)
+       IF (ABS(work2_c(1)).GT.lwork2) THEN
+          lwork2=work2_c(1)
+          DEALLOCATE (work2_c)
+          ALLOCATE (work2_c(lwork2), stat=err)
+          IF (err /= 0) THEN
+             WRITE (*,*) 'ERROR: chani.F: Allocating rwork failed:',lwork2
+             CALL juDFT_error('Failed to allocated "work2"', calledby ='chani')
+          ENDIF
+       ENDIF
+       IF (rwork(1).GT.lrwork) THEN
+          lrwork=rwork(1)
+          DEALLOCATE(rwork)
+          ! Allocate even more in case of clusters
+          ALLOCATE (rwork(lrwork+20*m), stat=err)
+          IF (err /= 0) THEN
+             WRITE (*,*) 'ERROR: chani.F: Allocating rwork failed: ', lrwork+20*m
+             CALL juDFT_error('Failed to allocated "rwork"', calledby ='chani')
+          ENDIF
+       ENDIF
+    endif
     IF (iwork(1) .GT. liwork) THEN
        liwork = iwork(1)
        DEALLOCATE (iwork)
@@ -351,18 +351,20 @@ endif
     !
     !     Now solve generalized eigenvalue problem
     !
-if (hamovlp%l_real) THEN
-    CALL CPP_LAPACK_pdsygvx(1,'V','I','U',m,asca_r,1,1,desca,bsca_r,1,1, desca,&
-         1.0,1.0,1,num,abstol,num1,num2,eig2,orfac,eigvec_r,1,1,&
-         desceigv,work2_r,lwork2,iwork,liwork,ifail,iclustr,&
-         gap,ierr)
-else
-    CALL CPP_LAPACK_pzhegvx(1,'V','I','U',m,asca_c,1,1,desca,bsca_c,1,1, desca,&
-         1.0,1.0,1,num,abstol,num1,num2,eig2,orfac,eigvec_c,1,1,&
-         desceigv,work2_c,lwork2,rwork,lrwork,iwork,liwork,&
-         ifail,iclustr,gap,ierr)
-    DEALLOCATE(rwork)
-endif
+    CALL timestart("SCALAPACK call")
+    if (hamovlp%l_real) THEN
+       CALL CPP_LAPACK_pdsygvx(1,'V','I','U',m,asca_r,1,1,desca,bsca_r,1,1, desca,&
+            1.0,1.0,1,num,abstol,num1,num2,eig2,orfac,eigvec_r,1,1,&
+            desceigv,work2_r,lwork2,iwork,liwork,ifail,iclustr,&
+            gap,ierr)
+    else
+       CALL CPP_LAPACK_pzhegvx(1,'V','I','U',m,asca_c,1,1,desca,bsca_c,1,1, desca,&
+            1.0,1.0,1,num,abstol,num1,num2,eig2,orfac,eigvec_c,1,1,&
+            desceigv,work2_c,lwork2,rwork,lrwork,iwork,liwork,&
+            ifail,iclustr,gap,ierr)
+       DEALLOCATE(rwork)
+    endif
+    CALL timestop("SCALAPACK call")
     IF (ierr .NE. 0) THEN
        IF (ierr /= 2) WRITE (6,*) myid,' error in pzhegvx/pdsygvx, ierr=',ierr
        IF (ierr <= 0) WRITE (6,*) myid,' illegal input argument'
@@ -426,7 +428,7 @@ endif
     !
     if (hamovlp%l_real) THEN
        CALL subredist2(m,num2,myrowssca,SUB_COMM,nprow,npcol, myid,ierr,nb,zmat%z_r,eigvec_r)
-       ELSE
+    ELSE
        CALL subredist2(m,num2,myrowssca,SUB_COMM,nprow,npcol, myid,ierr,nb,achi_c=zmat%z_c,asca_c=eigvec_c)
     end if
     !

juDFT/sysinfo.F90

-MODULE m_judft_sysinfo
-  IMPLICIT NONE
-CONTAINS
-  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"
+!--------------------------------------------------------------------------------
+! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
+! This file is part of FLEUR and available as free software under the conditions
+! of the MIT license as expressed in the LICENSE file in more detail.
+!--------------------------------------------------------------------------------
+
+
+!To generate Memory usage info on LINUX we need to know the pagesize
+!a default of 4096 bytes is assumed
+#ifndef CPP_PAGESIZE
+#define CPP_PAGESIZE 4096
+#endif
+ 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
+      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)
+    END SUBROUTINE print_memory_info
+
+    !Read mstat to find out current memory usage
+    FUNCTION memory_usage_string()
+      IMPLICIT NONE
+      CHARACTER(len=10):: memory_usage_string
+      INTEGER:: fid=543,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)") idum*CPP_PAGESIZE/(1024.*1024.*1024.),"GB"
+      ELSE
+         memory_usage_string=""
+      ENDIF
+    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"
        WRITE(*,*) "notice. Try 'ulimit -s unlimited'"
        WRITE(*,*) "*********** WARNING! ************"
     ENDIF

juDFT/time.F90

@@ -148,6 +148,7 @@ CONTAINS
 
   !>
   SUBROUTINE priv_debug_output(startstop,name)
+    USE m_judft_sysinfo
     IMPLICIT NONE
     CHARACTER(LEN=*),INTENT(IN):: startstop,name
 #ifdef CPP_MPI
@@ -157,9 +158,9 @@ CONTAINS
     IF (.NOT.l_debug) RETURN
 #ifdef CPP_MPI
     CALL MPI_COMM_RANK(MPI_COMM_WORLD,irank,ierr)
-    WRITE(*,"(i3,3a,f20.3)") irank,startstop,name," at:",cputime()
+    WRITE(*,"(i3,3a,f20.2,5x,a)") irank,startstop,name," at:",cputime(),memory_usage_string()
 #else
-    WRITE(*,"(3a,f20.3)") startstop,name," at:",cputime()
+    WRITE(*,"(3a,f20.2,5x,a)") startstop,name," at:",cputime(),memory_usage_string()
 #endif      
   END SUBROUTINE priv_debug_output