ec_cray_meminfo.F90

Go to the documentation of this file.

SUBROUTINE ec_cray_meminfo(IU,IDSTRING,KCOMM)

IMPLICIT NONE

!-- EC_CRAY_MEMINFO:
!   Author   : Peter Towers (ECMWF)  : 2015-2016
!   Modified : Sami Saarinen (ECMWF) : 21-SEP-2016 : Added getenv EC_MEMINFO -- export EC_MEMINFO=0 disables any EC_MEMINFO output
#ifdef SFX_MPI
include "mpif.h"
#endif

INTEGER(KIND=4), INTENT(IN) :: KCOMM
INTEGER(KIND=4), INTENT(IN) :: IU
CHARACTER*(*), INTENT(IN) :: IDSTRING
INTEGER(KIND = 4) :: ID,KULOUT
INTEGER(KIND=4) :: I,J,MYPROC,NPROC,LEN,ERROR,ITAG,NODENUM
INTEGER(KIND=8) :: TASKSMALL,NODEHUGE,MEMFREE,CACHED,NFREE
INTEGER(KIND=8) :: SMALLPAGE0,SMALLPAGE1,HUGEPAGE0,HUGEPAGE1
INTEGER(KIND=8) :: SENDBUF(9),RECVBUF(9)
INTEGER(KIND=8) :: GETHWM,GETMAXRSS
INTEGER(KIND=8) :: HEAP_SIZE
INTEGER(KIND=4) :: PAGESIZE,N18
INTEGER(KIND=4) :: NODE0(18),NODE1(18)
INTEGER(KIND=8) :: BUCKET0(18),BUCKET1(18)
REAL(KIND=4) :: PERCENT_USED(2)
CHARACTER(LEN=512) :: TMPDIR
CHARACTER(LEN=512) :: PROGRAM
CHARACTER(LEN=8)  :: NODENAME,LASTNODE
CHARACTER(LEN=12)  :: VAL
CHARACTER(LEN=1)  :: M
CHARACTER(LEN=160) ::LINE
CHARACTER(LEN=56) :: FILENAME
CHARACTER(LEN=128) :: JOBNAME
CHARACTER(LEN=128) :: JOBID
CHARACTER(LEN=2) :: EC_MEMINFO
CHARACTER(LEN=4) :: CSTAR
CHARACTER(LEN=LEN(CSTAR)+1+LEN(IDSTRING)) :: ID_STRING
CHARACTER (LEN = 10) ::  CLDATEOD,CLTIMEOD,CLZONEOD
INTEGER(KIND=4) :: IVALUES(8)
#ifdef SFX_MPI
INTEGER(KIND=4) :: IRECV_STATUS(mpi_status_size)
#endif
LOGICAL :: LLNOCOMM, LLNOHDR
CHARACTER(LEN=64) :: CLPFX
CHARACTER(LEN=3) :: ZUM
INTEGER(KIND=4) :: IPFXLEN
INTEGER OMP_GET_MAX_THREADS
EXTERNAL omp_get_max_threads

CALL getenv('EC_MEMINFO',ec_meminfo)
IF (ec_meminfo == '0') RETURN

llnocomm = (kcomm == -1 .or. kcomm == -2)
llnohdr = (kcomm == -2)

CALL flush(0)

IF (llnocomm) THEN
   ! Direct call to obtain EC_meminfo -output
   error = 0
   myproc = 0
   nproc = 1
   clpfx = idstring
   ipfxlen = len_trim(clpfx)
   zum = 'tsk'
ELSE
   clpfx = ' '
   ipfxlen = 0
   zum = 'sum'
#ifdef SFX_MPI
   CALL mpi_barrier(kcomm,error)
   
   CALL mpi_comm_rank(kcomm, myproc, error)
   
   IF(error /= 0 ) THEN
      WRITE(0,*) clpfx(1:ipfxlen)//"## EC_CRAY_MEMINFO error code ",error," from MPI_COMM_RANK"
      CALL mpi_abort(kcomm,-1,error)
   ENDIF

   CALL mpi_comm_size(kcomm,nproc,error)

   IF(error /= 0 ) THEN
      WRITE(0,*) clpfx(1:ipfxlen)//"## EC_CRAY_MEMINFO error code ",error," from MPI_COMM_SIZE"
      CALL mpi_abort(kcomm,-1,error)
   ENDIF
#else
   nproc = 1
   myproc = 0
#endif
ENDIF

IF(myproc == 0) THEN 
  CALL getarg(0,program)
!
! Use already open file for output or $TMPDIR/meminfo
!
  IF(iu == -1) THEN
    CALL getenv('TMPDIR',tmpdir)
    IF (tmpdir == ' ') tmpdir = '.'
    kulout=501
    OPEN(unit=kulout,file=trim(tmpdir)//"/"//"meminfo",status='unknown', &
         action='write',position='append')
  ELSE
    kulout=iu
  ENDIF

  CALL date_and_time(cldateod,cltimeod,clzoneod,ivalues)
  CALL getenv('EC_JOB_NAME',jobname)
  IF(jobname == '') THEN
    CALL getenv('PBS_JOBNAME',jobname)
  ENDIF
  CALL getenv('PBS_JOBID',jobid)

  IF (.not.llnocomm) THEN
     WRITE(kulout,'(a,/,a)') clpfx(1:ipfxlen)//"## EC_MEMINFO ",clpfx(1:ipfxlen)//"## EC_MEMINFO"
     WRITE(kulout,'(4a)') clpfx(1:ipfxlen)//"## EC_MEMINFO Detailed memory information ", &
          "for program ",trim(program)
#ifdef SFX_OMP
     WRITE(kulout,'(a,i5,a,i3,a,a,'':'',a,'':'',a,a,a,''-'',a,''-'',a)') &
          clpfx(1:ipfxlen)//"## EC_MEMINFO Running with ",nproc, &
          " tasks and ", omp_get_max_threads(), " threads at time ", &
          cltimeod(1:2),cltimeod(3:4),cltimeod(5:10), &
          " on ",cldateod(7:8),cldateod(5:6),cldateod(3:4)
#else
     WRITE(kulout,'(a,i5,a,i3,a,'':'',a,a,a,''-'',a,''-'',a)') &
          clpfx(1:ipfxlen)//"## EC_MEMINFO Running with ",nproc, &
          " tasks and 1 threads at time ", &
          cltimeod(1:2),cltimeod(3:4),cltimeod(5:10), &
          " on ",cldateod(7:8),cldateod(5:6),cldateod(3:4)
#endif
     WRITE(kulout,'(4a)') clpfx(1:ipfxlen)//"## EC_MEMINFO The Job Name is ",trim(jobname), &
          " and the Job ID is ",trim(jobid)
     WRITE(kulout,'(a)')  clpfx(1:ipfxlen)//"## EC_MEMINFO "
  ENDIF
  IF (.not.llnohdr) THEN
     WRITE(kulout,'(3a)') clpfx(1:ipfxlen)//"## EC_MEMINFO ", &
                       "              | TC    | MEMORY USED(MB) |", &
                       "          MEMORY FREE(MB)        INCLUDING CACHED |  %USED %HUGE"
     WRITE(kulout,'(4a)') clpfx(1:ipfxlen)//"## EC_MEMINFO ", &
                       "              | Malloc| Inc Heap        |", &
                       " Numa node 0    | Numa node 1    |                |"
     WRITE(kulout,'(4a)') clpfx(1:ipfxlen)//"## EC_MEMINFO ", &
                       "Node Name     | Heap  | RSS("//zum//")        |", &
                       " Small  Huge or | Small  Huge or | Total          |" 
     WRITE(kulout,'(4a)') clpfx(1:ipfxlen)//"## EC_MEMINFO ", &
                       "              | ("//zum//") | Small    Huge   |", &
                       "  Only   Small  |  Only   Small  | Memfree+Cached |"
  ENDIF
  IF(iu == -1) THEN
    WRITE(0,'(a,/,a)') clpfx(1:ipfxlen)//"## EC_MEMINFO ",clpfx(1:ipfxlen)//"## EC_MEMINFO"
    WRITE(0,'(4a)') clpfx(1:ipfxlen)//"## EC_MEMINFO Detailed memory information ", &
                    "for program ",trim(program)
#ifdef SFX_OMP
    WRITE(0,'(a,i5,a,i3,a,a,'':'',a,'':'',a,a,a,''-'',a,''-'',a)') &
                    clpfx(1:ipfxlen)//"## EC_MEMINFO Running with ",nproc, &
                    " tasks and ", omp_get_max_threads(), " threads at time ", &
                    cltimeod(1:2),cltimeod(3:4),cltimeod(5:10), &
                    " on ",cldateod(7:8),cldateod(5:6),cldateod(3:4)
#else
    WRITE(0,'(a,i5,a,i3,a,a,'':'',a,a,a,''-'',a,''-'',a)') &
                    clpfx(1:ipfxlen)//"## EC_MEMINFO Running with ",nproc, &
                    " tasks and 1 threads at time ", &
                    cltimeod(1:2),cltimeod(3:4),cltimeod(5:10), &
                    " on ",cldateod(7:8),cldateod(5:6),cldateod(3:4)
#endif
    WRITE(0,'(4a)') clpfx(1:ipfxlen)//"## EC_MEMINFO The Job Name is ",trim(jobname), &
                    " and the Job ID is ",trim(jobid)
    WRITE(0,'(a)')  clpfx(1:ipfxlen)//"## EC_MEMINFO "
    WRITE(0,'(3a)') clpfx(1:ipfxlen)//"## EC_MEMINFO ", &
                    "              | TC    | MEMORY USED(MB) |", &
                    "          MEMORY FREE(MB)        INCLUDING CACHED |  %USED %HUGE"
    WRITE(0,'(4a)') clpfx(1:ipfxlen)//"## EC_MEMINFO ", &
                    "              | Malloc| Inc Heap        |", &
                    " Numa node 0    | Numa node 1    |                |"
    WRITE(0,'(4a)') clpfx(1:ipfxlen)//"## EC_MEMINFO ", &
                    "Node Name     | Heap  | RSS("//zum//")        |", &
                    " Small  Huge or | Small  Huge or | Total          |" 
    WRITE(0,'(4a)') clpfx(1:ipfxlen)//"## EC_MEMINFO ", &
                    "              | ("//zum//") | Small    Huge   |", &
                    "  Only   Small  |  Only   Small  | Memfree+Cached |" 
  ENDIF
ENDIF

IF(error /= 0 ) THEN
  WRITE(0,*) clpfx(1:ipfxlen)//"## EC_CRAY_MEMINFO error code ",error," from MPI_BARRIER"
#ifdef SFX_MPI
  CALL mpi_abort(kcomm,-1,error)
#endif
ENDIF

#ifndef DARWIN
CALL ec_gethostname(nodename) ! from support/env.c
#endif

pagesize=2048
CALL getenv("HUGETLB_DEFAULT_PAGE_SIZE",val)
i=index(val,"M")
IF(i > 0) THEN
   READ(val(1:i-1),*) pagesize
   pagesize=pagesize*1024
ENDIF

nodehuge=0

WRITE(filename,'(a,i0,a)') "/sys/kernel/mm/hugepages/hugepages-", &
     pagesize,"kB/nr_hugepages"

IF(pagesize > 0) THEN
  OPEN(502,file=filename,status="old")
  READ(502,*) nodehuge
  CLOSE(502)
ENDIF

nodehuge=nodehuge*pagesize
memfree = 0
cached = 0
      
OPEN(file="/proc/meminfo",unit=502)
DO i=1,10
  READ(502,'(a)') line
  IF(line(1:7) == "MemFree") THEN
    READ(line(9:80),*) memfree 
  ELSEIF(line(1:6) == "Cached") THEN
    READ(line(8:80),*) cached
  ENDIF
ENDDO
CLOSE(502)

nodehuge=nodehuge/1024
memfree=memfree/1024
cached=cached/1024

tasksmall=getmaxrss()/(1024*1024)

OPEN(file="/proc/buddyinfo",unit=502)

READ(502,'(a)') line
READ(502,'(a)') line
READ(502,'(a)') line
node0(:)=-1
n18=0
READ(line(22:),*,end=98) node0
98 CONTINUE
n18 = count(node0 >= 0)
node1(:)=0
READ(502,'(a)',end=99) line
READ(line(22:),*) node1(1:n18)

99 CONTINUE
CLOSE(502)

bucket0(:) = 0
bucket1(:) = 0
bucket0(1)=node0(1)*4096
bucket1(1)=node1(1)*4096
DO i=2,n18
  bucket0(i)=node0(i)*4096
  bucket1(i)=node1(i)*4096
  DO j=2,i
    bucket0(i)=bucket0(i)*2
    bucket1(i)=bucket1(i)*2
  ENDDO
ENDDO

smallpage0=0
smallpage1=0
DO i=1,9
   smallpage0=smallpage0+bucket0(i)
   smallpage1=smallpage1+bucket1(i)
ENDDO
hugepage0=0
hugepage1=0
DO i=10,n18
   hugepage0=hugepage0+bucket0(i)
   hugepage1=hugepage1+bucket1(i)
ENDDO

smallpage0=smallpage0/(1024*1024)
smallpage1=smallpage1/(1024*1024)
hugepage0=hugepage0/(1024*1024)
hugepage1=hugepage1/(1024*1024)

heap_size=gethwm()/(1024*1024)

itag = 98765
IF(myproc == 0) THEN
    nodenum=1
    lastnode=nodename
#ifdef SFX_MPI
    DO i=1,nproc-1
        CALL mpi_recv(nodename(1:8),8,mpi_byte,i,itag,kcomm,irecv_status,error)
        IF(error /= 0 ) THEN
          WRITE(0,*) clpfx(1:ipfxlen)//"## EC_CRAY_MEMINFO error code ",error," from MPI_RECV"
          CALL mpi_abort(kcomm,-1,error)
        ENDIF
        CALL mpi_recv(recvbuf(1:9),9,mpi_integer8,i,itag+1,kcomm,irecv_status,error)
        IF(error /= 0 ) THEN
          WRITE(0,*) clpfx(1:ipfxlen)//"## EC_CRAY_MEMINFO error code ",error," from MPI_RECV"
          CALL mpi_abort(kcomm,-1,error)
        ENDIF
        IF(lastnode==nodename)THEN
          heap_size=heap_size+recvbuf(8)
          tasksmall=tasksmall+recvbuf(9)
        ELSE
          percent_used(2) = 0
          IF(heap_size > nodehuge) THEN
! running with small pages
            percent_used(1)=100.0*(tasksmall+nodehuge)/(tasksmall+nodehuge+memfree+cached)
            cstar = " s/p"
          ELSE
! running with huge pages
            percent_used(1)=100.0*(heap_size+tasksmall)/(tasksmall+nodehuge+memfree+cached)
            IF (nodehuge > 0) THEN
               nfree = hugepage0 + hugepage1
               percent_used(2) = (100.0*(nodehuge - nfree))/nodehuge
            ENDIF
            cstar = " H/p"
          ENDIF
          IF (.not.llnocomm) THEN
             id_string = cstar//":"//idstring
          ELSE
             id_string = cstar
          ENDIF
          WRITE(kulout,'(a,i4,1x,a,3i8,2x,2i8,1x,2i8,2x,2i8,3x,2f6.1,a)') clpfx(1:ipfxlen)//"## EC_MEMINFO ", &
 &                      nodenum,lastnode,heap_size,tasksmall,nodehuge,   &
 &                      smallpage0,hugepage0,smallpage1,hugepage1,memfree,cached, &
 &                      percent_used,trim(id_string)
          IF(iu == -1) THEN
            WRITE(0,'(a,i4,1x,a,3i8,2x,2i8,1x,2i8,2x,2i8,3x,2f6.1,a)') clpfx(1:ipfxlen)//"## EC_MEMINFO ", &
 &                   nodenum,lastnode,heap_size,tasksmall,nodehuge,   &
 &                   smallpage0,hugepage0,smallpage1,hugepage1,memfree,cached, &
 &                   percent_used,trim(id_string)
          ENDIF

          nodehuge=recvbuf(1)
          memfree=recvbuf(2)
          cached=recvbuf(3)
          smallpage0=recvbuf(4)
          smallpage1=recvbuf(5)
          hugepage0=recvbuf(6)
          hugepage1=recvbuf(7)
          heap_size=recvbuf(8)
          tasksmall=recvbuf(9)
          nodenum=nodenum+1
          lastnode=nodename
        ENDIF
    ENDDO
#endif
    percent_used(2) = 0
    IF(heap_size > nodehuge) THEN
! running with small pages
      percent_used(1)=100.0*(tasksmall+nodehuge)/(tasksmall+nodehuge+memfree+cached)
      cstar = " s/p"
    ELSE
! running with huge pages
      percent_used(1)=100.0*(heap_size+tasksmall)/(tasksmall+nodehuge+memfree+cached)
      IF (nodehuge > 0) THEN
         nfree = hugepage0 + hugepage1
         percent_used(2) = (100.0*(nodehuge - nfree))/nodehuge
      ENDIF
      cstar = " H/p"
    ENDIF
    IF (.not.llnocomm) THEN
       id_string = cstar//":"//idstring
    ELSE
       id_string = cstar
    ENDIF
    WRITE(kulout,'(a,i4,1x,a,3i8,2x,2i8,1x,2i8,2x,2i8,3x,2f6.1,a)') clpfx(1:ipfxlen)//"## EC_MEMINFO ", &
 &                nodenum,lastnode,heap_size,tasksmall,nodehuge,   &
 &                smallpage0,hugepage0,smallpage1,hugepage1,memfree,cached, &
 &                percent_used,trim(id_string)

    IF(iu == -1) THEN
      WRITE(0,'(a,i4,1x,a,3i8,2x,2i8,1x,2i8,2x,2i8,3x,2f6.1,a)') clpfx(1:ipfxlen)//"## EC_MEMINFO ", &
 &                  nodenum,lastnode,heap_size,tasksmall,nodehuge,   &
 &                  smallpage0,hugepage0,smallpage1,hugepage1,memfree,cached, &
 &                  percent_used,trim(id_string)
      CLOSE(kulout)
    ENDIF
ELSE
#ifdef SFX_MPI
    CALL mpi_send(nodename(1:8),8,mpi_byte,0,itag,kcomm,error)
    IF(error /= 0 ) THEN
       WRITE(0,*) clpfx(1:ipfxlen)//"## EC_CRAY_MEMINFO error code ",error," from MPI_SEND"
       CALL mpi_abort(kcomm,-1,error)
    ENDIF
#endif
    sendbuf(1)=nodehuge
    sendbuf(2)=memfree
    sendbuf(3)=cached
    sendbuf(4)=smallpage0
    sendbuf(5)=smallpage1
    sendbuf(6)=hugepage0
    sendbuf(7)=hugepage1
    sendbuf(8)=heap_size
    sendbuf(9)=tasksmall
#ifdef SFX_MPI
    CALL mpi_send(sendbuf(1:9),9,mpi_integer8,0,itag+1,kcomm,error)
    IF(error /= 0 ) THEN
       WRITE(0,*) clpfx(1:ipfxlen)//"## EC_CRAY_MEMINFO error code ",error," from MPI_SEND"
       CALL mpi_abort(kcomm,-1,error)
    ENDIF
#endif
ENDIF
#ifdef SFX_MPI
IF (.not.llnocomm) CALL mpi_barrier(kcomm,error)
#endif
END SUBROUTINE ec_cray_meminfo

SUBROUTINE meminfo(KOUT,KSTEP)
IMPLICIT NONE
INTEGER(KIND=4), INTENT(IN) :: KOUT, KSTEP
CHARACTER(LEN=32) CLSTEP
CHARACTER(LEN=160) :: LINE
CHARACTER(LEN=8) :: NODENAME
INTEGER(KIND=8) :: NODE(0:17), ISMALL, IHUGE, ITOTAL
INTEGER(KIND=4) :: I,INUMA,ICOMM
WRITE(clstep,'(11X,"STEP",I5," :")') kstep
icomm = -2 ! No headers from EC_CRAY_MEMINFO by default
IF (kstep == 0) icomm = -1 ! Do print headers, too
#ifdef _CRAYFTN
CALL ec_cray_meminfo(kout,trim(clstep),icomm)
#endif
CALL flush(kout)
RETURN ! For now
#ifndef DARWIN
CALL ec_gethostname(nodename) ! from support/env.c
#endif
OPEN(file="/proc/buddyinfo",unit=502,err=98)
READ(502,'(a)') line
READ(502,'(a)') line
DO inuma=0,1
   node(:)=0
   READ(502,'(a)',end=99) line
   READ(line(22:160),*,err=99,end=99) node
   ismall = 0
   DO i=0,8
      ismall = ismall + node(i) * (2**i)
   ENDDO
   ! Pages >= 2M
   ihuge = 0
   DO i=9,SIZE(node)-1
      ihuge = ihuge + node(i) * (2**i)
   ENDDO
   itotal = ismall + ihuge
   ismall = (ismall * 4096)/(1024*1024)
   ihuge = (ihuge * 4096)/(1024*1024)
   itotal = (itotal * 4096)/(1024*1024)
   WRITE(kout,'("   MEMINFO: STEP=",I0," ",A," NUMA# ",I0," : Free Total = SMALL + HUGEPAGES in MB: ",I0," = ",I0," + ",I0)') &
        & kstep, nodename, inuma, itotal, ismall, ihuge
   WRITE(kout,'(" BUDDYINFO: STEP=",I0," ",A," NUMA# ",I0," : Count of free 2^(0..",I0,")*4096B blocks: ",A)') &
        & kstep, nodename, inuma, SIZE(node)-1, line(22:160)
ENDDO
99 CONTINUE
CLOSE(502)
98 CONTINUE
CALL flush(kout)
END SUBROUTINE meminfo