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 petscsys.h
  7: #if defined(PETSC_HAVE_STDLIB_H)
  8: #include <stdlib.h>
  9: #endif
 10: #if defined(PETSC_HAVE_MALLOC_H)
 11: #include <malloc.h>
 12: #endif


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


 24: #define COOKIE_VALUE   ((PetscCookie) 0xf0e0d0c9)
 25: #define ALREADY_FREED  ((PetscCookie) 0x0f0e0d9c)

 27: typedef struct _trSPACE {
 28:     size_t          size;
 29:     int             id;
 30:     int             lineno;
 31:     const char      *filename;
 32:     const char      *functionname;
 33:     const char      *dirname;
 34:     PetscCookie     cookie;
 35: #if defined(PETSC_USE_DEBUG)
 36:     PetscStack      stack;
 37: #endif
 38:     struct _trSPACE *next,*prev;
 39: } TRSPACE;

 41: /* HEADER_BYTES is the number of bytes in a PetscMalloc() header.
 42:    It is sizeof(TRSPACE) padded to be a multiple of PETSC_MEMALIGN.
 43: */

 45: #define HEADER_BYTES      (sizeof(TRSPACE)+(PETSC_MEMALIGN-1)) & ~(PETSC_MEMALIGN-1)


 48: /* This union is used to insure that the block passed to the user retains
 49:    a minimum alignment of PETSC_MEMALIGN.
 50: */
 51: typedef union {
 52:     TRSPACE sp;
 53:     char    v[HEADER_BYTES];
 54: } TrSPACE;


 57: static size_t     TRallocated  = 0;
 58: static int        TRfrags      = 0;
 59: static TRSPACE    *TRhead      = 0;
 60: static int        TRid         = 0;
 61: static PetscTruth TRdebugLevel = PETSC_FALSE;
 62: static size_t     TRMaxMem     = 0;
 63: /*
 64:       Arrays to log information on all Mallocs
 65: */
 66: static int        PetscLogMallocMax = 10000,PetscLogMalloc = -1;
 67: static size_t     *PetscLogMallocLength;
 68: static const char **PetscLogMallocDirectory,**PetscLogMallocFile,**PetscLogMallocFunction;

 72: PetscErrorCode PetscSetUseTrMalloc_Private(void)
 73: {

 77:   PetscMallocSet(PetscTrMallocDefault,PetscTrFreeDefault);
 78:   TRallocated       = 0;
 79:   TRfrags           = 0;
 80:   TRhead            = 0;
 81:   TRid              = 0;
 82:   TRdebugLevel      = PETSC_FALSE;
 83:   TRMaxMem          = 0;
 84:   PetscLogMallocMax = 10000;
 85:   PetscLogMalloc    = -1;
 86:   return(0);
 87: }

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

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

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

107:    Level: advanced

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

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

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

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

120: .seealso: CHKMEMQ

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

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

161: /*
162:     PetscTrMallocDefault - Malloc with tracing.

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

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

183:   if (!a) {
184:     SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Trying to malloc zero size array");
185:   }

187:   if (TRdebugLevel) {
188:     PetscMallocValidate(lineno,function,filename,dir); if (ierr) PetscFunctionReturn(ierr);
189:   }

191:   nsize = (a + (PETSC_MEMALIGN-1)) & ~(PETSC_MEMALIGN-1);
192:   PetscMallocAlign(nsize+sizeof(TrSPACE)+sizeof(PetscCookie),lineno,function,filename,dir,(void**)&inew);

194:   head   = (TRSPACE *)inew;
195:   inew  += sizeof(TrSPACE);

197:   if (TRhead) TRhead->prev = head;
198:   head->next     = TRhead;
199:   TRhead         = head;
200:   head->prev     = 0;
201:   head->size     = nsize;
202:   head->id       = TRid;
203:   head->lineno   = lineno;

205:   head->filename     = filename;
206:   head->functionname = function;
207:   head->dirname      = dir;
208:   head->cookie       = COOKIE_VALUE;
209:   *(PetscCookie *)(inew + nsize) = COOKIE_VALUE;

211:   TRallocated += nsize;
212:   if (TRallocated > TRMaxMem) {
213:     TRMaxMem   = TRallocated;
214:   }
215:   TRfrags++;

217: #if defined(PETSC_USE_DEBUG)
218:   PetscStackCopy(petscstack,&head->stack);
219: #endif

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


247: /*
248:    PetscTrFreeDefault - Free with tracing.

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


331: /*@C
332:     PetscMemoryShowUsage - Shows the amount of memory currently being used 
333:         in a communicator.
334:    
335:     Collective on PetscViewer

337:     Input Parameter:
338: +    viewer - the viewer that defines the communicator
339: -    message - string printed before values

341:     Level: intermediate

343:     Concepts: memory usage

345: .seealso: PetscMallocDump(), PetscMemoryGetCurrentUsage()
346:  @*/
347: PetscErrorCode  PetscMemoryShowUsage(PetscViewer viewer,const char message[])
348: {
349:   PetscLogDouble allocated,maximum,resident,residentmax;
351:   PetscMPIInt    rank;
352:   MPI_Comm       comm;

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

381: /*@C
382:     PetscMallocGetCurrentUsage - gets the current amount of memory used that was PetscMalloc()ed
383:    
384:     Not Collective

386:     Output Parameters:
387: .   space - number of bytes currently allocated

389:     Level: intermediate

391:     Concepts: memory usage

393: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocGetMaximumUsage(), PetscMemoryGetCurrentUsage(),
394:           PetscMemoryGetMaximumUsage()
395:  @*/
396: PetscErrorCode  PetscMallocGetCurrentUsage(PetscLogDouble *space)
397: {
399:   *space = (PetscLogDouble) TRallocated;
400:   return(0);
401: }

405: /*@C
406:     PetscMallocGetMaximumUsage - gets the maximum amount of memory used that was PetscMalloc()ed at any time
407:         during this run.
408:    
409:     Not Collective

411:     Output Parameters:
412: .   space - maximum number of bytes ever allocated at one time

414:     Level: intermediate

416:     Concepts: memory usage

418: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocGetMaximumUsage(), PetscMemoryGetCurrentUsage(),
419:           PetscMemoryGetCurrentUsage()
420:  @*/
421: PetscErrorCode  PetscMallocGetMaximumUsage(PetscLogDouble *space)
422: {
424:   *space = (PetscLogDouble) TRMaxMem;
425:   return(0);
426: }

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

436:    Collective on PETSC_COMM_WORLD

438:    Input Parameter:
439: .  fp  - file pointer.  If fp is NULL, stdout is assumed.

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

444:    Level: intermediate

446:    Fortran Note:
447:    The calling sequence in Fortran is PetscMallocDump(integer ierr)
448:    The fp defaults to stdout.

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

453:    Concepts: memory usage
454:    Concepts: memory bleeding
455:    Concepts: bleeding memory

457: .seealso:  PetscMallocGetCurrentUsage(), PetscMallocDumpLog() 
458: @*/
459: PetscErrorCode  PetscMallocDump(FILE *fp)
460: {
461:   TRSPACE        *head;
463:   PetscMPIInt    rank;

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

482: /* ---------------------------------------------------------------------------- */

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

489:     Not Collective

491:     Options Database Key:
492: .  -malloc_log - Activates PetscMallocDumpLog()

494:     Level: advanced

496: .seealso: PetscMallocDump(), PetscMallocDumpLog()
497: @*/
498: PetscErrorCode  PetscMallocSetDumpLog(void)
499: {

503:   PetscLogMalloc = 0;
504:   PetscMemorySetGetMaximumUsage();
505:   return(0);
506: }

510: /*@C
511:     PetscMallocDumpLog - Dumps the log of all calls to PetscMalloc(); also calls
512:        PetscMemoryGetMaximumUsage()

514:     Collective on PETSC_COMM_WORLD

516:     Input Parameter:
517: .   fp - file pointer; or PETSC_NULL

519:     Options Database Key:
520: .  -malloc_log - Activates PetscMallocDumpLog()

522:     Level: advanced

524:    Fortran Note:
525:    The calling sequence in Fortran is PetscMallocDumpLog(integer ierr)
526:    The fp defaults to stdout.

528: .seealso: PetscMallocGetCurrentUsage(), PetscMallocDump(), PetscMallocSetDumpLog()
529: @*/
530: PetscErrorCode  PetscMallocDumpLog(FILE *fp)
531: {
532:   PetscInt       i,j,n,dummy,*perm;
533:   size_t         *shortlength;
534:   int            *shortcount,err;
535:   PetscMPIInt    rank,size,tag = 1212 /* very bad programming */;
536:   PetscTruth     match;
537:   const char     **shortfunction;
538:   PetscLogDouble rss;
539:   MPI_Status     status;

543:   MPI_Comm_rank(MPI_COMM_WORLD,&rank);
544:   MPI_Comm_size(MPI_COMM_WORLD,&size);
545:   /*
546:        Try to get the data printed in order by processor. This will only sometimes work 
547:   */
548:   err = fflush(fp);
549:   if (err) SETERRQ(PETSC_ERR_SYS,"fflush() failed on file");

551:   MPI_Barrier(MPI_COMM_WORLD);
552:   if (rank) {
553:     MPI_Recv(&dummy,1,MPIU_INT,rank-1,tag,MPI_COMM_WORLD,&status);
554:   }

556:   if (!fp) fp = PETSC_STDOUT;
557:   PetscMemoryGetMaximumUsage(&rss);
558:   if (rss) {
559:     PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Maximum memory PetscMalloc()ed %.0f maximum size of entire process %.0f\n",rank,(PetscLogDouble)TRMaxMem,rss);
560:   } else {
561:     PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Maximum memory PetscMalloc()ed %.0f OS cannot compute size of entire process\n",rank,(PetscLogDouble)TRMaxMem);
562:   }
563:   if (PetscLogMalloc < 0) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"PetscMallocDumpLog() called without call to PetscMallocSetDumpLog() this is often due to\n                      setting the option -malloc_log AFTER PetscInitialize() with PetscOptionsInsert() or PetscOptionsInsertFile()");
564:   shortcount       = (int*)malloc(PetscLogMalloc*sizeof(int));if (!shortcount) SETERRQ(PETSC_ERR_MEM,"Out of memory");
565:   shortlength      = (size_t*)malloc(PetscLogMalloc*sizeof(size_t));if (!shortlength) SETERRQ(PETSC_ERR_MEM,"Out of memory");
566:   shortfunction    = (const char**)malloc(PetscLogMalloc*sizeof(char *));if (!shortfunction) SETERRQ(PETSC_ERR_MEM,"Out of memory");
567:   shortfunction[0] = PetscLogMallocFunction[0];
568:   shortlength[0]   = PetscLogMallocLength[0];
569:   shortcount[0]    = 0;
570:   n = 1;
571:   for (i=1; i<PetscLogMalloc; i++) {
572:     for (j=0; j<n; j++) {
573:       PetscStrcmp(shortfunction[j],PetscLogMallocFunction[i],&match);
574:       if (match) {
575:         shortlength[j] += PetscLogMallocLength[i];
576:         shortcount[j]++;
577:         goto foundit;
578:       }
579:     }
580:     shortfunction[n] = PetscLogMallocFunction[i];
581:     shortlength[n]   = PetscLogMallocLength[i];
582:     shortcount[n]    = 1;
583:     n++;
584:     foundit:;
585:   }

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

591:   PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Memory usage sorted by function\n",rank);
592:   for (i=0; i<n; i++) {
593:     PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] %d %.0f %s()\n",rank,shortcount[perm[i]],(PetscLogDouble)shortlength[perm[i]],shortfunction[perm[i]]);
594:   }
595:   free(perm);
596:   free(shortlength);
597:   free(shortcount);
598:   free((char **)shortfunction);
599:   err = fflush(fp);
600:   if (err) SETERRQ(PETSC_ERR_SYS,"fflush() failed on file");
601:   if (rank != size-1) {
602:     MPI_Send(&dummy,1,MPIU_INT,rank+1,tag,MPI_COMM_WORLD);
603:   }
604:   return(0);
605: }

607: /* ---------------------------------------------------------------------------- */

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

614:     Not Collective

616:     Input Parameter:
617: .   level - PETSC_TRUE or PETSC_FALSE

619:    Level: intermediate

621: .seealso: CHKMEMQ(), PetscMallocValidate()
622: @*/
623: PetscErrorCode  PetscMallocDebug(PetscTruth level)
624: {
626:   TRdebugLevel = level;
627:   return(0);
628: }