MA stats for external heap allocation

ma/f2c.c

@@ -335,3 +335,17 @@ public Boolean FATR f2c_verify_allocator_stuff_()
 {
     return MA_verify_allocator_stuff();
 }
+
+public Boolean FATR f2c_count_heap_(datatype, nelem)
+    Integer *datatype;
+    Integer *nelem;
+{
+    return MA_count_heap(*datatype, *nelem);
+}
+
+public Boolean FATR f2c_uncount_heap_(datatype, nelem)
+    Integer *datatype;
+    Integer *nelem;
+{
+    return MA_uncount_heap(*datatype, *nelem);
+}

ma/ma.c

@@ -429,6 +429,8 @@ typedef enum
     FID_MA_sizeof_overhead,
     FID_MA_summarize_allocated_blocks,
     FID_MA_trace,
+    FID_MA_count_heap,
+    FID_MA_uncount_heap,
     FID_MA_verify_allocator_stuff
 } FID;
 
@@ -3688,3 +3690,135 @@ public Boolean MA_verify_allocator_stuff()
 
 #endif /* VERIFY */
 }
+
+/* ------------------------------------------------------------------------- */
+/*
+ * Add the size of an _external_ allocation (i.e. Fortran allocate) to MA stats
+ * to allow applications (e.g. NWChem) to accurately track their memory
+ * consumption.
+ *
+ * Return MA_TRUE upon success, or MA_FALSE upon failure.
+ */
+/* ------------------------------------------------------------------------- */
+
+public Boolean MA_count_heap(
+    Integer       datatype,     /* of elements in the block */
+    Integer       nelem         /* # of elements in the block */
+    )
+{
+    ulongi nbytes;
+
+#ifdef STATS
+    ma_stats.calls[(int)FID_MA_count_heap]++;
+#endif /* STATS */
+
+    if (ma_trace)
+    (void)printf("MA: counting (%d)\n", (int)nelem);
+
+    /* verify initialization */
+    if (!ma_initialized)
+    {
+        (void)sprintf(ma_ebuf, "MA not yet initialized");
+        ma_error(EL_Nonfatal, ET_External, "MA_count_heap", ma_ebuf);
+        return MA_FALSE;
+    }
+
+    /* verify datatype */
+    if (!mt_valid(datatype))
+    {
+        (void)sprintf(ma_ebuf, "invalid datatype: %ld", (size_t)datatype);
+        ma_error(EL_Nonfatal, ET_External, "MA_count_heap", ma_ebuf);
+        return MA_FALSE;
+    }
+
+    /* verify nelem */
+    if (nelem < 0)
+    {
+        (void)sprintf(ma_ebuf, "invalid nelem: %ld", (size_t)nelem);
+        ma_error(EL_Nonfatal, ET_External, "MA_count_heap", ma_ebuf);
+        return MA_FALSE;
+    }
+
+    /* convert datatype to internal (index-suitable) value */
+    datatype = mt_import(datatype);
+
+    /* compute the number of bytes in an element */
+    nbytes = ma_sizeof[datatype];
+
+    /* total number of bytes */
+    nbytes *= nelem;
+
+#ifdef STATS
+    ma_stats.hblocks++;
+    ma_stats.hblocks_max = max(ma_stats.hblocks, ma_stats.hblocks_max);
+    ma_stats.hbytes += nbytes;
+    ma_stats.hbytes_max = max(ma_stats.hbytes, ma_stats.hbytes_max);
+#endif /* STATS */
+
+    return MA_TRUE;
+}
+
+/* ------------------------------------------------------------------------- */
+/*
+ * Subtract the size of an _external_ allocation (i.e. Fortran allocate) to MA stats
+ * to allow applications (e.g. NWChem) to accurately track their memory
+ * consumption.
+ *
+ * Return MA_TRUE upon success, or MA_FALSE upon failure.
+ */
+/* ------------------------------------------------------------------------- */
+
+public Boolean MA_uncount_heap(
+    Integer       datatype,     /* of elements in the block */
+    Integer       nelem         /* # of elements in the block */
+    )
+{
+    ulongi nbytes;
+
+#ifdef STATS
+    ma_stats.calls[(int)FID_MA_uncount_heap]++;
+#endif /* STATS */
+
+    if (ma_trace)
+    (void)printf("MA: uncounting (%d)\n", (int)nelem);
+
+    /* verify initialization */
+    if (!ma_initialized)
+    {
+        (void)sprintf(ma_ebuf, "MA not yet initialized");
+        ma_error(EL_Nonfatal, ET_External, "MA_uncount_heap", ma_ebuf);
+        return MA_FALSE;
+    }
+
+    /* verify datatype */
+    if (!mt_valid(datatype))
+    {
+        (void)sprintf(ma_ebuf, "invalid datatype: %ld", (size_t)datatype);
+        ma_error(EL_Nonfatal, ET_External, "MA_uncount_heap", ma_ebuf);
+        return MA_FALSE;
+    }
+
+    /* verify nelem */
+    if (nelem < 0)
+    {
+        (void)sprintf(ma_ebuf, "invalid nelem: %ld", (size_t)nelem);
+        ma_error(EL_Nonfatal, ET_External, "MA_uncount_heap", ma_ebuf);
+        return MA_FALSE;
+    }
+
+    /* convert datatype to internal (index-suitable) value */
+    datatype = mt_import(datatype);
+
+    /* compute the number of bytes in an element */
+    nbytes = ma_sizeof[datatype];
+
+    /* total number of bytes */
+    nbytes *= nelem;
+
+#ifdef STATS
+    ma_stats.hblocks--;
+    ma_stats.hbytes -= nbytes;
+#endif /* STATS */
+
+    return MA_TRUE;
+}

ma/ma.h

@@ -50,5 +50,7 @@ extern void MAi_summarize_allocated_blocks(int index_base);
 #define f2c_trace_                      F77_FUNC_(f2c_trace,F2C_TRACE)
 #define f2c_verify_allocator_stuff_     F77_FUNC_(f2c_verify_allocator_stuff,F2C_VERIFY_ALLOCATOR_STUFF)
 #define ma_set_sizes_                   F77_FUNC_(ma_set_sizes,MA_SET_SIZES)
+#define f2c_count_heap_                 F77_FUNC_(f2c_count_heap,F2C_COUNT_HEAP)
+#define f2c_uncount_heap_               F77_FUNC_(f2c_uncount_heap,F2C_UNCOUNT_HEAP)
 
 #endif /* _ma_h */

ma/macdecls.h

@@ -102,6 +102,13 @@ extern void MA_trace(Boolean value);
 extern Boolean MA_verify_allocator_stuff();
 extern void MA_set_error_callback(void(*func)());
 
+extern Boolean MA_count_heap(
+    Integer     datatype,       /**< of elements in this block */
+    Integer     nelem           /**< # of elements in this block */);
+extern Boolean MA_uncount_heap(
+    Integer     datatype,       /**< of elements in this block */
+    Integer     nelem           /**< # of elements in this block */);
+
 extern void ma_set_error_callback();
 
 /**

ma/maf.F

@@ -675,4 +675,46 @@ logical function MA_verify_allocator_stuff ()
       return
       end
 
+c     --------------------------------------------------------------- c
+c     --------------------------------------------------------------- c
+
+      logical function MA_count_heap (datatype, nelem)
+
+      implicit none
+
+      integer datatype
+      integer nelem
+
+#include "maf2c.fh"
+
+      if (f2c_count_heap(datatype, nelem) .eq. MA_TRUE) then
+          MA_count_heap = .true.
+      else
+          MA_count_heap = .false.
+      endif
+
+      return
+      end
+
+c     --------------------------------------------------------------- c
+c     --------------------------------------------------------------- c
+
+      logical function MA_uncount_heap (datatype, nelem)
+
+      implicit none
+
+      integer datatype
+      integer nelem
+
+#include "maf2c.fh"
+
+      if (f2c_uncount_heap(datatype, nelem) .eq. MA_TRUE) then
+          MA_uncount_heap = .true.
+      else
+          MA_uncount_heap = .false.
+      endif
+
+      return
+      end
+
 #undef MAF_INTERNAL

ma/maf2c.fh

@@ -56,6 +56,8 @@ c     void f2c_print_stats
 c     void f2c_summarize_allocated_blocks
 c     void f2c_trace
       integer f2c_verify_allocator_stuff
+      integer f2c_count_heap
+      integer f2c_uncount_heap
 
       external f2c_alloc_get
       external f2c_allocate_heap
@@ -89,3 +91,5 @@ c     void f2c_trace
       external f2c_summarize_allocated_blocks
       external f2c_trace
       external f2c_verify_allocator_stuff
+      external f2c_count_heap
+      external f2c_uncount_heap