Actual source code: mtr.c

      1: #define PETSC_DLL
      2: /*
      3:      Interface to malloc() and free(). This code allows for
      4:   logging of memory usage and some error checking
      5: */
     6:  #include petsc.h
     7:  #include petscsys.h
      8: #if defined(PETSC_HAVE_STDLIB_H)
      9: #include <stdlib.h>
     10: #endif
     11: #if defined(PETSC_HAVE_MALLOC_H)
     12: #include <malloc.h>
     13: #endif
     14: #include "petscfix.h"

     17: /*
     18:      These are defined in mal.c and ensure that malloced space is PetscScalar aligned
     19: */
     20: EXTERN PetscErrorCode PETSC_DLLEXPORT PetscMallocAlign(size_t,int,const char[],const char[],const char[],void**);
     21: EXTERN PetscErrorCode PETSC_DLLEXPORT PetscFreeAlign(void*,int,const char[],const char[],const char[]);
     22: EXTERN PetscErrorCode PETSC_DLLEXPORT PetscTrMallocDefault(size_t,int,const char[],const char[],const char[],void**);
     23: EXTERN PetscErrorCode PETSC_DLLEXPORT PetscTrFreeDefault(void*,int,const char[],const char[],const char[]);

     27: PetscErrorCode PetscSetUseTrMalloc_Private(void)
     28: {

     32:   PetscSetMalloc(PetscTrMallocDefault,PetscTrFreeDefault);
     33:   return(0);
     34: }

     36: #if (PETSC_SIZEOF_VOID_P == 8)
     37: #define TR_ALIGN_BYTES      8
     38: #define TR_ALIGN_MASK       0x7
     39: #else
     40: #define TR_ALIGN_BYTES      4
     41: #define TR_ALIGN_MASK       0x3
     42: #endif

     44: #define COOKIE_VALUE   0xf0e0d0c9
     45: #define ALREADY_FREED  0x0f0e0d9c
     46: #define MAX_TR_STACK   20
     47: #define TR_MALLOC      0x1
     48: #define TR_FREE        0x2

     50: typedef struct _trSPACE {
     51:     size_t          size;
     52:     int             id;
     53:     int             lineno;
     54:     const char      *filename;
     55:     const char      *functionname;
     56:     const char      *dirname;
     57:     unsigned long   cookie;
     58: #if defined(PETSC_USE_DEBUG)
     59:     PetscStack      stack;
     60: #endif
     61:     struct _trSPACE *next,*prev;
     62: } TRSPACE;

     64: /* HEADER_DOUBLES is the number of doubles in a PetscMalloc() header */
     65: /* We have to be careful about alignment rules here */

     67: #define HEADER_DOUBLES      sizeof(TRSPACE)/sizeof(double)+1

     70: /* This union is used to insure that the block passed to the user is
     71:    aligned on a double boundary */
     72: typedef union {
     73:     TRSPACE sp;
     74:     double  v[HEADER_DOUBLES];
     75: } TrSPACE;

     77: static size_t     TRallocated  = 0;
     78: static int        TRfrags      = 0;
     79: static TRSPACE    *TRhead      = 0;
     80: static int        TRid         = 0;
     81: static PetscTruth TRdebugLevel = PETSC_FALSE;
     82: static size_t     TRMaxMem     = 0;
     83: /*
     84:       Arrays to log information on all Mallocs
     85: */
     86: static int        PetscLogMallocMax = 10000,PetscLogMalloc = -1;
     87: static size_t     *PetscLogMallocLength;
     88: static const char **PetscLogMallocDirectory,**PetscLogMallocFile,**PetscLogMallocFunction;

     92: /*@C
     93:    PetscMallocValidate - Test the memory for corruption.  This can be used to
     94:    check for memory overwrites.

     96:    Input Parameter:
     97: +  line - line number where call originated.
     98: .  function - name of function calling
     99: .  file - file where function is
    100: -  dir - directory where function is

    102:    Return value:
    103:    The number of errors detected.
    104:
    105:    Output Effect:
    106:    Error messages are written to stdout.

    108:    Level: advanced

    110:    Notes:
    111:     You should generally use CHKMEMQ as a short cut for calling this
    112:     routine.

    114:     The line, function, file and dir are given by the C preprocessor as
    115:     __LINE__, __FUNCT__, __FILE__, and __DIR__

    117:     The Fortran calling sequence is simply PetscMallocValidate(ierr)

    119:    No output is generated if there are no problems detected.

    121: .seealso: CHKMEMQ

    123: @*/
    124: PetscErrorCode PETSC_DLLEXPORT PetscMallocValidate(int line,const char function[],const char file[],const char dir[])
    125: {
    126:   TRSPACE       *head;
    127:   char          *a;
    128:   unsigned long *nend;

    131:   head = TRhead;
    132:   while (head) {
    133:     if (head->cookie != COOKIE_VALUE) {
    134:       (*PetscErrorPrintf)("PetscMallocValidate: error detected at  %s() line %d in %s%s\n",function,line,dir,file);
    135:       (*PetscErrorPrintf)("Memory at address %p is corrupted\n",head);
    136:       (*PetscErrorPrintf)("Probably write past beginning or end of array\n");
    137:       SETERRQ(PETSC_ERR_MEMC," ");
    138:     }
    139:     a    = (char *)(((TrSPACE*)head) + 1);
    140:     nend = (unsigned long *)(a + head->size);
    141:     if (*nend != COOKIE_VALUE) {
    142:       (*PetscErrorPrintf)("PetscMallocValidate: error detected at %s() line %d in %s%s\n",function,line,dir,file);
    143:       if (*nend == ALREADY_FREED) {
    144:         (*PetscErrorPrintf)("Memory [id=%d(%.0f)] at address %p already freed\n",head->id,(PetscLogDouble)head->size,a);
    145:         SETERRQ(PETSC_ERR_MEMC," ");
    146:       } else {
    147:         (*PetscErrorPrintf)("Memory [id=%d(%.0f)] at address %p is corrupted (probably write past end of array)\n",head->id,(PetscLogDouble)head->size,a);
    148:         (*PetscErrorPrintf)("Memory originally allocated in %s() line %d in %s%s\n",head->functionname,head->lineno,head->dirname,head->filename);
    149:         SETERRQ(PETSC_ERR_MEMC," ");
    150:       }
    151:     }
    152:     head = head->next;
    153:   }
    154:   return(0);
    155: }

    159: /*
    160:     PetscTrMallocDefault - Malloc with tracing.

    162:     Input Parameters:
    163: +   a   - number of bytes to allocate
    164: .   lineno - line number where used.  Use __LINE__ for this
    165: .   function - function calling routine. Use __FUNCT__ for this
    166: .   filename  - file name where used.  Use __FILE__ for this
    167: -   dir - directory where file is. Use __SDIR__ for this

    169:     Returns:
    170:     double aligned pointer to requested storage, or null if not
    171:     available.
    172:  */
    173: PetscErrorCode PETSC_DLLEXPORT PetscTrMallocDefault(size_t a,int lineno,const char function[],const char filename[],const char dir[],void**result)
    174: {
    175:   TRSPACE        *head;
    176:   char           *inew;
    177:   size_t         nsize;

    181:   if (TRdebugLevel) {
    182:     PetscMallocValidate(lineno,function,filename,dir); if (ierr) PetscFunctionReturn(ierr);
    183:   }
    184:   if (!a) SETERRQ(PETSC_ERR_MEM_MALLOC_0,"Cannot malloc size zero");

    186:   nsize = a;
    187:   if (nsize & TR_ALIGN_MASK) nsize += (TR_ALIGN_BYTES - (nsize & TR_ALIGN_MASK));
    188:   PetscMallocAlign(nsize+sizeof(TrSPACE)+sizeof(PetscScalar),lineno,function,filename,dir,(void**)&inew);

    190:   head   = (TRSPACE *)inew;
    191:   inew  += sizeof(TrSPACE);

    193:   if (TRhead) TRhead->prev = head;
    194:   head->next     = TRhead;
    195:   TRhead         = head;
    196:   head->prev     = 0;
    197:   head->size     = nsize;
    198:   head->id       = TRid;
    199:   head->lineno   = lineno;

    201:   head->filename     = filename;
    202:   head->functionname = function;
    203:   head->dirname      = dir;
    204:   head->cookie       = COOKIE_VALUE;
    205:   *(unsigned long *)(inew + nsize) = COOKIE_VALUE;

    207:   TRallocated += nsize;
    208:   if (TRallocated > TRMaxMem) {
    209:     TRMaxMem   = TRallocated;
    210:   }
    211:   TRfrags++;

    213: #if defined(PETSC_USE_DEBUG)
    214:   PetscStackCopy(petscstack,&head->stack);
    215: #endif

    217:   /*
    218:          Allow logging of all mallocs made
    219:   */
    220:   if (PetscLogMalloc > -1 && PetscLogMalloc < PetscLogMallocMax) {
    221:     if (!PetscLogMalloc) {
    222:       PetscLogMallocLength    = (size_t*)malloc(PetscLogMallocMax*sizeof(size_t));
    223:       if (!PetscLogMallocLength) SETERRQ(PETSC_ERR_MEM," ");
    224:       PetscLogMallocDirectory = (const char**)malloc(PetscLogMallocMax*sizeof(char**));
    225:       if (!PetscLogMallocDirectory) SETERRQ(PETSC_ERR_MEM," ");
    226:       PetscLogMallocFile      = (const char**)malloc(PetscLogMallocMax*sizeof(char**));
    227:       if (!PetscLogMallocFile) SETERRQ(PETSC_ERR_MEM," ");
    228:       PetscLogMallocFunction  = (const char**)malloc(PetscLogMallocMax*sizeof(char**));
    229:       if (!PetscLogMallocFunction) SETERRQ(PETSC_ERR_MEM," ");
    230:     }
    231:     PetscLogMallocLength[PetscLogMalloc]      = nsize;
    232:     PetscLogMallocDirectory[PetscLogMalloc]   = dir;
    233:     PetscLogMallocFile[PetscLogMalloc]        = filename;
    234:     PetscLogMallocFunction[PetscLogMalloc++]  = function;
    235:   }
    236:   *result = (void*)inew;
    237:   return(0);
    238: }

    243: /*
    244:    PetscTrFreeDefault - Free with tracing.

    246:    Input Parameters:
    247: .   a    - pointer to a block allocated with PetscTrMalloc
    248: .   lineno - line number where used.  Use __LINE__ for this
    249: .   function - function calling routine. Use __FUNCT__ for this
    250: .   file  - file name where used.  Use __FILE__ for this
    251: .   dir - directory where file is. Use __SDIR__ for this
    252:  */
    253: PetscErrorCode PETSC_DLLEXPORT PetscTrFreeDefault(void *aa,int line,const char function[],const char file[],const char dir[])
    254: {
    255:   char           *a = (char*)aa;
    256:   TRSPACE        *head;
    257:   char           *ahead;
    259:   unsigned long  *nend;
    260:
    262:   /* Do not try to handle empty blocks */
    263:   if (!a) {
    264:     (*PetscErrorPrintf)("PetscTrFreeDefault called from %s() line %d in %s%s\n",function,line,dir,file);
    265:     SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Trying to free null block");
    266:   }
    267:
    268:   if (TRdebugLevel) {
    269:     PetscMallocValidate(line,function,file,dir);
    270:   }
    271:
    272:   ahead = a;
    273:   a     = a - sizeof(TrSPACE);
    274:   head  = (TRSPACE *)a;
    275:
    276:   if (head->cookie != COOKIE_VALUE) {
    277:     (*PetscErrorPrintf)("PetscTrFreeDefault() called from %s() line %d in %s%s\n",function,line,dir,file);
    278:     (*PetscErrorPrintf)("Block at address %p is corrupted; cannot free;\nmay be block not allocated with PetscMalloc()\n",a);
    279:     SETERRQ(PETSC_ERR_MEMC,"Bad location or corrupted memory");
    280:   }
    281:   nend = (unsigned long *)(ahead + head->size);
    282:   if (*nend != COOKIE_VALUE) {
    283:     if (*nend == ALREADY_FREED) {
    284:       (*PetscErrorPrintf)("PetscTrFreeDefault() called from %s() line %d in %s%s\n",function,line,dir,file);
    285:       (*PetscErrorPrintf)("Block [id=%d(%.0f)] at address %p was already freed\n",head->id,(PetscLogDouble)head->size,a + sizeof(TrSPACE));
    286:       if (head->lineno > 0 && head->lineno < 50000 /* sanity check */) {
    287:         (*PetscErrorPrintf)("Block freed in %s() line %d in %s%s\n",head->functionname,head->lineno,head->dirname,head->filename);
    288:       } else {
    289:         (*PetscErrorPrintf)("Block allocated in %s() line %d in %s%s\n",head->functionname,-head->lineno,head->dirname,head->filename);
    290:       }
    291:       SETERRQ(PETSC_ERR_ARG_WRONG,"Memory already freed");
    292:     } else {
    293:       /* Damaged tail */
    294:       (*PetscErrorPrintf)("PetscTrFreeDefault() called from %s() line %d in %s%s\n",function,line,dir,file);
    295:       (*PetscErrorPrintf)("Block [id=%d(%.0f)] at address %p is corrupted (probably write past end of array)\n",head->id,(PetscLogDouble)head->size,a);
    296:       (*PetscErrorPrintf)("Block allocated in %s() line %d in %s%s\n",head->functionname,head->lineno,head->dirname,head->filename);
    297:       SETERRQ(PETSC_ERR_MEMC,"Corrupted memory");
    298:     }
    299:   }
    300:   /* Mark the location freed */
    301:   *nend        = ALREADY_FREED;
    302:   /* Save location where freed.  If we suspect the line number, mark as  allocated location */
    303:   if (line > 0 && line < 50000) {
    304:     head->lineno       = line;
    305:     head->filename     = file;
    306:     head->functionname = function;
    307:     head->dirname      = dir;
    308:   } else {
    309:     head->lineno = - head->lineno;
    310:   }
    311:   /* zero out memory - helps to find some reuse of already freed memory */
    312:   PetscMemzero(aa,head->size);
    313:
    314:   TRallocated -= head->size;
    315:   TRfrags     --;
    316:   if (head->prev) head->prev->next = head->next;
    317:   else TRhead = head->next;
    318:
    319:   if (head->next) head->next->prev = head->prev;
    320:   PetscFreeAlign(a,line,function,file,dir);
    321:   return(0);
    322: }

    327: /*@
    328:     PetscMemoryShowUsage - Shows the amount of memory currently being used
    329:         in a communicator.
    330:
    331:     Collective on PetscViewer

    333:     Input Parameter:
    334: +    viewer - the viewer that defines the communicator
    335: -    message - string printed before values

    337:     Level: intermediate

    339:     Concepts: memory usage

    341: .seealso: PetscMemoryDump(), PetscMemoryGetCurrentUsage()
    342:  @*/
    343: PetscErrorCode PETSC_DLLEXPORT PetscMemoryShowUsage(PetscViewer viewer,const char message[])
    344: {
    345:   PetscLogDouble allocated,maximum,resident,residentmax;
    347:   PetscMPIInt    rank;
    348:   MPI_Comm       comm;

    351:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_WORLD;
    352:   PetscMallocGetCurrentUsage(&allocated);
    353:   PetscMallocGetMaximumUsage(&maximum);
    354:   PetscMemoryGetCurrentUsage(&resident);
    355:   PetscMemoryGetMaximumUsage(&residentmax);
    356:   if (residentmax > 0) residentmax = PetscMax(resident,residentmax);
    357:   PetscObjectGetComm((PetscObject)viewer,&comm);
    358:   MPI_Comm_rank(comm,&rank);
    359:   PetscViewerASCIIPrintf(viewer,message);
    360:   if (resident && residentmax && allocated) {
    361:     PetscViewerASCIISynchronizedPrintf(viewer,"[%d]Current space PetscMalloc()ed %g, max space PetscMalloced() %g\n[%d]Current process memory %g max process memory %g\n",rank,allocated,maximum,rank,resident,residentmax);
    362:   } else if (resident && residentmax) {
    363:     PetscViewerASCIISynchronizedPrintf(viewer,"[%d]Run with -malloc to get statistics on PetscMalloc() calls\n[%d]Current process memory %g max process memory %g\n",rank,rank,resident,residentmax);
    364:   } else if (resident && allocated) {
    365:     PetscViewerASCIISynchronizedPrintf(viewer,"[%d]Current space PetscMalloc()ed %g, max space PetscMalloced() %g\n[%d]Current process memory %g, run with -memory_info to get max memory usage\n",rank,allocated,maximum,rank,resident);
    366:   } else if (allocated) {
    367:     PetscViewerASCIISynchronizedPrintf(viewer,"[%d]Current space PetscMalloc()ed %g, max space PetscMalloced() %g\n[%d]OS cannot compute process memory\n",rank,allocated,maximum,rank);
    368:   } else {
    369:     PetscViewerASCIIPrintf(viewer,"Run with -malloc to get statistics on PetscMalloc() calls\nOS cannot compute process memory\n");
    370:   }
    371:   PetscViewerFlush(viewer);
    372:   return(0);
    373: }

    377: /*@C
    378:     PetscMallocGetCurrentUsage - gets the current amount of memory used that was PetscMalloc()ed
    379:
    380:     Not Collective

    382:     Output Parameters:
    383: .   space - number of bytes currently allocated

    385:     Level: intermediate

    387:     Concepts: memory usage

    389: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocGetMaximumUsage(), PetscMemoryGetCurrentUsage(),
    390:           PetscMemoryGetMaximumUsage()
    391:  @*/
    392: PetscErrorCode PETSC_DLLEXPORT PetscMallocGetCurrentUsage(PetscLogDouble *space)
    393: {
    395:   *space = (PetscLogDouble) TRallocated;
    396:   return(0);
    397: }

    401: /*@C
    402:     PetscMallocGetMaximumUsage - gets the maximum amount of memory used that was PetscMalloc()ed at any time
    403:         during this run.
    404:
    405:     Not Collective

    407:     Output Parameters:
    408: .   space - maximum number of bytes ever allocated at one time

    410:     Level: intermediate

    412:     Concepts: memory usage

    414: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocGetMaximumUsage(), PetscMemoryGetCurrentUsage(),
    415:           PetscMemoryGetCurrentUsage()
    416:  @*/
    417: PetscErrorCode PETSC_DLLEXPORT PetscMallocGetMaximumUsage(PetscLogDouble *space)
    418: {
    420:   *space = (PetscLogDouble) TRMaxMem;
    421:   return(0);
    422: }

    426: /*@C
    427:    PetscMallocDump - Dumps the allocated memory blocks to a file. The information
    428:    printed is: size of space (in bytes), address of space, id of space,
    429:    file in which space was allocated, and line number at which it was
    430:    allocated.

    432:    Collective on PETSC_COMM_WORLD

    434:    Input Parameter:
    435: .  fp  - file pointer.  If fp is NULL, stdout is assumed.

    437:    Options Database Key:
    438: .  -malloc_dump - Dumps unfreed memory during call to PetscFinalize()

    440:    Level: intermediate

    442:    Fortran Note:
    443:    The calling sequence in Fortran is PetscMallocDump(integer ierr)
    444:    The fp defaults to stdout.

    446:    Notes: uses MPI_COMM_WORLD, because this may be called in PetscFinalize() after PETSC_COMM_WORLD
    447:           has been freed.

    449:    Concepts: memory usage
    450:    Concepts: memory bleeding
    451:    Concepts: bleeding memory

    453: .seealso:  PetscMallocGetCurrentSize(), PetscMallocDumpLog()
    454: @*/
    455: PetscErrorCode PETSC_DLLEXPORT PetscMallocDump(FILE *fp)
    456: {
    457:   TRSPACE        *head;
    459:   PetscMPIInt    rank;

    462:   MPI_Comm_rank(MPI_COMM_WORLD,&rank);
    463:   if (!fp) fp = stdout;
    464:   if (TRallocated > 0) {
    465:     fprintf(fp,"[%d]Total space allocated %.0f bytes\n",rank,(PetscLogDouble)TRallocated);
    466:   }
    467:   head = TRhead;
    468:   while (head) {
    469:     fprintf(fp,"[%2d]%.0f bytes %s() line %d in %s%s\n",rank,(PetscLogDouble)head->size,head->functionname,head->lineno,head->dirname,head->filename);
    470: #if defined(PETSC_USE_DEBUG)
    471:     PetscStackPrint(&head->stack,fp);
    472: #endif
    473:     head = head->next;
    474:   }
    475:   return(0);
    476: }

    478: /* ---------------------------------------------------------------------------- */

    482: /*@C
    483:     PetscMallocSetDumpLog - Activates logging of all calls to PetscMalloc().

    485:     Not Collective

    487:     Options Database Key:
    488: .  -malloc_log - Activates PetscMallocDumpLog()

    490:     Level: advanced

    492: .seealso: PetscMallocDump(), PetscMallocDumpLog()
    493: @*/
    494: PetscErrorCode PETSC_DLLEXPORT PetscMallocSetDumpLog(void)
    495: {
    497:   PetscLogMalloc = 0;
    498:   return(0);
    499: }

    503: /*@C
    504:     PetscMallocDumpLog - Dumps the log of all calls to PetscMalloc(); also calls
    505:        PetscMemoryGetCurrentUsage() and PetscMemoryGetMaximumUsage()

    507:     Collective on PETSC_COMM_WORLD

    509:     Input Parameter:
    510: .   fp - file pointer; or PETSC_NULL

    512:     Options Database Key:
    513: .  -malloc_log - Activates PetscMallocDumpLog()

    515:     Level: advanced

    517:    Fortran Note:
    518:    The calling sequence in Fortran is PetscMallocDumpLog(integer ierr)
    519:    The fp defaults to stdout.

    521: .seealso: PetscMallocGetCurrentUsage(), PetscMallocDump(), PetscMallocSetDumpLog()
    522: @*/
    523: PetscErrorCode PETSC_DLLEXPORT PetscMallocDumpLog(FILE *fp)
    524: {
    525:   PetscInt       i,j,n,dummy,*perm;
    526:   size_t         *shortlength;
    527:   PetscMPIInt    rank,size,tag = 1212 /* very bad programming */;
    528:   PetscTruth     match;
    529:   const char     **shortfunction;
    530:   PetscLogDouble rss;
    531:   MPI_Status     status;

    535:   MPI_Comm_rank(MPI_COMM_WORLD,&rank);
    536:   MPI_Comm_size(MPI_COMM_WORLD,&size);
    537:   /*
    538:        Try to get the data printed in order by processor. This will only sometimes work
    539:   */
    540:   fflush(fp);
    541:   MPI_Barrier(MPI_COMM_WORLD);
    542:   if (rank) {
    543:     MPI_Recv(&dummy,1,MPIU_INT,rank-1,tag,MPI_COMM_WORLD,&status);
    544:   }

    546:   if (!fp) fp = stdout;
    547:   PetscMemoryGetCurrentUsage(&rss);
    548:   if (rss) {
    549:     PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Maximum memory PetscMalloc()ed %.0f maximum size of entire process %D\n",rank,(PetscLogDouble)TRMaxMem,rss);
    550:   } else {
    551:     PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Maximum memory PetscMalloc()ed %.0f OS cannot compute size of entire process\n",rank,(PetscLogDouble)TRMaxMem);
    552:   }
    553:   shortlength      = (size_t*)malloc(PetscLogMalloc*sizeof(size_t));if (!shortlength) SETERRQ(PETSC_ERR_MEM,"Out of memory");
    554:   shortfunction    = (const char**)malloc(PetscLogMalloc*sizeof(char *));if (!shortfunction) SETERRQ(PETSC_ERR_MEM,"Out of memory");
    555:   shortfunction[0] = PetscLogMallocFunction[0];
    556:   shortlength[0]   = PetscLogMallocLength[0];
    557:   n = 1;
    558:   for (i=1; i<PetscLogMalloc; i++) {
    559:     for (j=0; j<n; j++) {
    560:       PetscStrcmp(shortfunction[j],PetscLogMallocFunction[i],&match);
    561:       if (match) {
    562:         shortlength[j] += PetscLogMallocLength[i];
    563:         goto foundit;
    564:       }
    565:     }
    566:     shortfunction[n] = PetscLogMallocFunction[i];
    567:     shortlength[n]   = PetscLogMallocLength[i];
    568:     n++;
    569:     foundit:;
    570:   }

    572:   perm = (PetscInt*)malloc(n*sizeof(PetscInt));if (!perm) SETERRQ(PETSC_ERR_MEM,"Out of memory");
    573:   for (i=0; i<n; i++) perm[i] = i;
    574:   PetscSortStrWithPermutation(n,(const char **)shortfunction,perm);

    576:   PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Memory usage sorted by function\n",rank);
    577:   for (i=0; i<n; i++) {
    578:     PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] %.0f %s()\n",rank,(PetscLogDouble)shortlength[perm[i]],shortfunction[perm[i]]);
    579:   }
    580:   free(perm);
    581:   free(shortlength);
    582:   free((char **)shortfunction);
    583:   fflush(fp);
    584:   if (rank != size-1) {
    585:     MPI_Send(&dummy,1,MPIU_INT,rank+1,tag,MPI_COMM_WORLD);
    586:   }
    587:   return(0);
    588: }

    590: /* ---------------------------------------------------------------------------- */

    594: /*@C
    595:     PetscMallocDebug - Turns on/off debugging for the memory management routines.

    597:     Not Collective

    599:     Input Parameter:
    600: .   level - PETSC_TRUE or PETSC_FALSE

    602:    Level: intermediate

    604: .seealso: CHKMEMQ(), PetscMallocValidate()
    605: @*/
    606: PetscErrorCode PETSC_DLLEXPORT PetscMallocDebug(PetscTruth level)
    607: {
    609:   TRdebugLevel = level;
    610:   return(0);
    611: }