getmemstat.F90

Go to the documentation of this file.

SUBROUTINE getmemstat(KOUT, CDLABEL)

USE parkind1  ,ONLY : jpim     ,jprb     ,jpib
#ifdef SFX_MPI
USE mpl_module
#endif
IMPLICIT NONE

INTEGER(KIND=JPIM), INTENT(IN) :: KOUT
CHARACTER(LEN=*), INTENT(IN) :: CDLABEL
INTEGER(KIND=JPIM) :: I, IMYPROC, INPROC, IOFFSET
INTEGER(KIND=JPIM), PARAMETER :: JP_MEMKEYS = 5  ! pls. consult ifsaux/utilities/getmemvals.F90
INTEGER(KIND=JPIM) IMEMKEYS(jp_memkeys)
INTEGER(KIND=JPIB) IMEMVALS(jp_memkeys)
REAL(KIND=JPRB), ALLOCATABLE :: ZSEND(:), ZRECV(:)
INTEGER(KIND=JPIM), ALLOCATABLE :: ICOUNTS(:)
CHARACTER(LEN=1) CLENV

CALL get_environment_variable("EC_PROFILE_MEM", clenv) ! turn OFF by export EC_PROFILE_MEM=0

IF (kout >= 0 .AND. clenv /= '0') THEN
#ifdef SFX_MPI
  imyproc = mpl_myrank()
  inproc  = mpl_nproc()
#else
  imyproc = 0
  inproc = 1
#endif 
  ALLOCATE(zsend(jp_memkeys))
  ALLOCATE(zrecv(jp_memkeys * inproc))
  ALLOCATE(icounts(inproc))

!                 1=MAXHEAP, 2=MAXRSS, 3=CURRENTHEAP, 5=MAXSTACK, 6=PAGING
  imemkeys(:) = (/1,         2,        3,             5,          6/) 
  CALL getmemvals(jp_memkeys, imemkeys, imemvals)

  zsend(:) = 0
  DO i=1,jp_memkeys
    zsend(i) = imemvals(i)
  ENDDO
  zrecv(:) = -1

  icounts(:) = jp_memkeys
#ifdef SFX_MPI
  CALL mpl_gatherv(zsend(:), kroot=1, krecvcounts=icounts(:), &
                  &precvbuf=zrecv, cdstring='GETMEMSTAT:')
#endif

  IF (imyproc == 1) THEN
     WRITE(kout,9000) trim(cdlabel)
9000 FORMAT(/,"Memory Utilization Information (in bytes) : ",a,/,79("="),//,&
         &  "Node   Max heapsize   Max resident   Current heap      Max stack   I/O-paging #",/,&
         &  "====   ============   ============   ============   ============   ============",//)
     ioffset = 0
     DO i=1,inproc
       imemvals(:) = zrecv(ioffset+1:ioffset+jp_memkeys)
       WRITE(kout,'(I4,5(3X,I12))') i,imemvals(:)
       ioffset = ioffset + jp_memkeys
     ENDDO
     WRITE(kout,'(/,a,/)') 'End of Memory Utilization Information'
  ENDIF

  DEALLOCATE(zsend)
  DEALLOCATE(zrecv)
  DEALLOCATE(icounts)

  CALL getheapstat(kout, cdlabel)
ENDIF
END SUBROUTINE getmemstat