getheapstat.F90

Go to the documentation of this file.

SUBROUTINE getheapstat(KOUT, CDLABEL)

USE parkind1  ,ONLY : jpim     ,jprb     ,jpib
#ifdef SFX_MPI
USE mpl_module
#endif
#ifdef NAG
USE f90_unix_env, ONLY: getenv
#endif

IMPLICIT NONE

INTEGER(KIND=JPIM), INTENT(IN) :: KOUT
CHARACTER(LEN=*), INTENT(IN) :: CDLABEL
INTEGER(KIND=JPIM) :: I, IMYPROC, INPROC, IRET, IOFFSET, II
INTEGER(KIND=JPIM), PARAMETER :: JP_NPROFILE = 9 ! pls. consult ifsaux/utilities/getcurheap.c
INTEGER(KIND=JPIM), PARAMETER :: ISIZE = jp_nprofile+1
INTEGER(KIND=JPIB) ILIMIT(isize)
INTEGER(KIND=JPIB) ICNT(isize)
REAL(KIND=JPRB), ALLOCATABLE :: ZSEND(:), ZRECV(:)
INTEGER(KIND=JPIM), ALLOCATABLE :: ICOUNTS(:)
CHARACTER(LEN=1) CLENV
CHARACTER(LEN=80) CLTEXT(0:4)

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

IF (kout >= 0 .AND. clenv /= '0') THEN
#ifdef SFX_MPI
  imyproc = mpl_myrank()
  inproc  = mpl_nproc()
#else
  imyproc = 0
  inproc = 1
#endif
  DO i=1,isize
    ilimit(i) = i ! power of 10's ; pls. consult ifsaux/utilities/getcurheap.c
  ENDDO

  ALLOCATE(zsend(isize))
  ALLOCATE(zrecv(isize * inproc))
  ALLOCATE(icounts(inproc))

  cltext(0) = "free()/DEALLOCATE -hits per byte range"
  cltext(1) = "malloc()/ALLOCATE -hits per byte range"
  cltext(2) = "Outstanding malloc()/ALLOCATE -hits per byte range"
  cltext(3) = "Outstanding amount of malloc()/ALLOCATE -bytes per byte range"
  cltext(4) = "Average amount of outstanding malloc()/ALLOCATE -bytes per byte range"

  DO ii=0,4
    icnt(:) = 0
    CALL profile_heap_get(icnt, isize, ii, iret)

    zsend(:) = 0
    DO i=1,iret
      zsend(i) = icnt(i)
    ENDDO
    zrecv(:) = -1

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

    IF (imyproc == 1) THEN
!     Not more than 132 columns, please :-)
      WRITE(kout,9000) trim(cltext(ii)),trim(cdlabel), "Node", &
                     & (ilimit(i),i=1,min(jp_nprofile,9)), "Larger"
9000  FORMAT(/,"Heap Utilization Profile (",a,"): ",a,&
            &/,126("="),&
            &//,(a4,2x,9(:,2x,4x,"< 10^",i1),:,2x,a10))
      WRITE(kout,9001)
9001  FORMAT(4("="),2x,10(2x,10("="))/)
      ioffset = 0
      DO i=1,inproc
        icnt(:) = zrecv(ioffset+1:ioffset+isize)
        WRITE(kout,'(i4,2x,(10(:,2x,i10)))') i,icnt(:)
        ioffset = ioffset + isize
      ENDDO
    ENDIF
  ENDDO

  IF (imyproc == 1) THEN
    WRITE(kout,'(/,a,/)') 'End of Heap Utilization Profile'
  ENDIF

  DEALLOCATE(zsend)
  DEALLOCATE(zrecv)
  DEALLOCATE(icounts)
ENDIF
END SUBROUTINE getheapstat