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,*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 PETSC_DLLEXPORT 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 (TRdebugLevel) {
185:     PetscMallocValidate(lineno,function,filename,dir); if (ierr) PetscFunctionReturn(ierr);
186:   }
187:   if (!a) SETERRQ(PETSC_ERR_MEM_MALLOC_0,"Cannot malloc size zero");

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

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

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

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

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

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

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


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

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


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

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

340:     Level: intermediate

342:     Concepts: memory usage

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

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

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

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

388:     Level: intermediate

390:     Concepts: memory usage

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

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

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

413:     Level: intermediate

415:     Concepts: memory usage

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

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

435:    Collective on PETSC_COMM_WORLD

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

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

443:    Level: intermediate

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

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

452:    Concepts: memory usage
453:    Concepts: memory bleeding
454:    Concepts: bleeding memory

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

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

481: /* ---------------------------------------------------------------------------- */

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

488:     Not Collective

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

493:     Level: advanced

495: .seealso: PetscMallocDump(), PetscMallocDumpLog()
496: @*/
497: PetscErrorCode PETSC_DLLEXPORT PetscMallocSetDumpLog(void)
498: {
500:   PetscLogMalloc = 0;
501:   return(0);
502: }

506: /*@C
507:     PetscMallocDumpLog - Dumps the log of all calls to PetscMalloc(); also calls 
508:        PetscMemoryGetCurrentUsage() and PetscMemoryGetMaximumUsage()

510:     Collective on PETSC_COMM_WORLD

512:     Input Parameter:
513: .   fp - file pointer; or PETSC_NULL

515:     Options Database Key:
516: .  -malloc_log - Activates PetscMallocDumpLog()

518:     Level: advanced

520:    Fortran Note:
521:    The calling sequence in Fortran is PetscMallocDumpLog(integer ierr)
522:    The fp defaults to stdout.

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

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

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

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

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

593: /* ---------------------------------------------------------------------------- */

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

600:     Not Collective

602:     Input Parameter:
603: .   level - PETSC_TRUE or PETSC_FALSE

605:    Level: intermediate

607: .seealso: CHKMEMQ(), PetscMallocValidate()
608: @*/
609: PetscErrorCode PETSC_DLLEXPORT PetscMallocDebug(PetscTruth level)
610: {
612:   TRdebugLevel = level;
613:   return(0);
614: }