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  PetscMallocAlign(size_t,int,const char[],const char[],const char[],void**);
 21: EXTERN PetscErrorCode  PetscFreeAlign(void*,int,const char[],const char[],const char[]);
 22: EXTERN PetscErrorCode  PetscTrMallocDefault(size_t,int,const char[],const char[],const char[],void**);
 23: EXTERN PetscErrorCode  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  PetscMallocValidate(int line,const char function[],const char file[],const char dir[])
125: {
126:   TRSPACE       *head,*lasthead;
127:   char          *a;
128:   unsigned long *nend;

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

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

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

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

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

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

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

196:   head   = (TRSPACE *)inew;
197:   inew  += sizeof(TrSPACE);

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

207:   head->filename     = filename;
208:   head->functionname = function;
209:   head->dirname      = dir;
210:   head->cookie       = COOKIE_VALUE;
211:   *(unsigned long *)(inew + nsize) = COOKIE_VALUE;

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

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

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


249: /*
250:    PetscTrFreeDefault - Free with tracing.

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


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

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

343:     Level: intermediate

345:     Concepts: memory usage

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

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

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

388:     Output Parameters:
389: .   space - number of bytes currently allocated

391:     Level: intermediate

393:     Concepts: memory usage

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

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

413:     Output Parameters:
414: .   space - maximum number of bytes ever allocated at one time

416:     Level: intermediate

418:     Concepts: memory usage

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

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

438:    Collective on PETSC_COMM_WORLD

440:    Input Parameter:
441: .  fp  - file pointer.  If fp is NULL, stdout is assumed.

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

446:    Level: intermediate

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

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

455:    Concepts: memory usage
456:    Concepts: memory bleeding
457:    Concepts: bleeding memory

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

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

484: /* ---------------------------------------------------------------------------- */

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

491:     Not Collective

493:     Options Database Key:
494: .  -malloc_log - Activates PetscMallocDumpLog()

496:     Level: advanced

498: .seealso: PetscMallocDump(), PetscMallocDumpLog()
499: @*/
500: PetscErrorCode  PetscMallocSetDumpLog(void)
501: {
503:   PetscLogMalloc = 0;
504:   return(0);
505: }

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

513:     Collective on PETSC_COMM_WORLD

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

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

521:     Level: advanced

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

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

542:   MPI_Comm_rank(MPI_COMM_WORLD,&rank);
543:   MPI_Comm_size(MPI_COMM_WORLD,&size);
544:   /*
545:        Try to get the data printed in order by processor. This will only sometimes work 
546:   */
547:   fflush(fp);
548:   MPI_Barrier(MPI_COMM_WORLD);
549:   if (rank) {
550:     MPI_Recv(&dummy,1,MPIU_INT,rank-1,tag,MPI_COMM_WORLD,&status);
551:   }

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

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

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

602: /* ---------------------------------------------------------------------------- */

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

609:     Not Collective

611:     Input Parameter:
612: .   level - PETSC_TRUE or PETSC_FALSE

614:    Level: intermediate

616: .seealso: CHKMEMQ(), PetscMallocValidate()
617: @*/
618: PetscErrorCode  PetscMallocDebug(PetscTruth level)
619: {
621:   TRdebugLevel = level;
622:   return(0);
623: }