sysinfo.F90 3.83 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12
!--------------------------------------------------------------------------------
! 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
13 14 15
MODULE m_judft_sysinfo
  IMPLICIT NONE
CONTAINS
16
  
17 18 19 20 21 22 23 24 25
  
  
  !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
26
    LOGICAL :: l_mpi=.FALSE.
27
#ifdef CPP_MPI
28
    INCLUDE 'mpif.h'
29 30 31 32 33 34
    CALL mpi_initialized(l_mpi,err)
    IF (l_mpi) THEN
       CALL MPI_COMM_RANK(MPI_COMM_WORLD,irank,err)
    ELSE
       irank=0
    ENDIF
35
#else
36
    irank=0
37
#endif
38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63
    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
64

65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83
    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
84 85
    
   
86 87 88
  SUBROUTINE checkstack()
    CHARACTER(LEN=10):: l1,l2,l3,l4
    INTEGER          :: err
89
    LOGICAL          :: unlimited,l_mpi
90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105
#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
106 107 108
    CALL mpi_initialized(l_mpi,ierr)
    irank=0
    if (l_mpi) CALL MPI_COMM_RANK(MPI_COMM_WORLD,irank,ierr)
109 110 111 112 113 114 115 116 117
    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"
118 119 120 121 122 123 124 125 126 127 128
       WRITE(*,*) "notice. Try 'ulimit -s unlimited'"
       WRITE(*,*) "*********** WARNING! ************"
    ENDIF
  END SUBROUTINE checkstack
END MODULE m_judft_sysinfo

!program test
!  use m_judft_sysinfo
!  call checkstack()

!end program test