Actual source code: mtr.c
petsc-3.3-p7 2013-05-11
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> /*I "petscsys.h" I*/
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 CLASSID_VALUE ((PetscClassId) 0xf0e0d0c9)
25: #define ALREADY_FREED ((PetscClassId) 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: PetscClassId classid;
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 PetscBool 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: PetscClassId *nend;
130: head = TRhead; lasthead = NULL;
131: while (head) {
132: if (head->classid != CLASSID_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_COMM_SELF,PETSC_ERR_MEMC," ");
139: }
140: a = (char *)(((TrSPACE*)head) + 1);
141: nend = (PetscClassId *)(a + head->size);
142: if (*nend != CLASSID_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_COMM_SELF,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_COMM_SELF,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) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Trying to malloc zero size array");
185: if (TRdebugLevel) {
186: PetscMallocValidate(lineno,function,filename,dir); if (ierr) PetscFunctionReturn(ierr);
187: }
189: nsize = (a + (PETSC_MEMALIGN-1)) & ~(PETSC_MEMALIGN-1);
190: PetscMallocAlign(nsize+sizeof(TrSPACE)+sizeof(PetscClassId),lineno,function,filename,dir,(void**)&inew);
192: head = (TRSPACE *)inew;
193: inew += sizeof(TrSPACE);
195: if (TRhead) TRhead->prev = head;
196: head->next = TRhead;
197: TRhead = head;
198: head->prev = 0;
199: head->size = nsize;
200: head->id = TRid;
201: head->lineno = lineno;
203: head->filename = filename;
204: head->functionname = function;
205: head->dirname = dir;
206: head->classid = CLASSID_VALUE;
207: *(PetscClassId *)(inew + nsize) = CLASSID_VALUE;
209: TRallocated += nsize;
210: if (TRallocated > TRMaxMem) {
211: TRMaxMem = TRallocated;
212: }
213: TRfrags++;
215: #if defined(PETSC_USE_DEBUG)
216: PetscStackCopy(petscstack,&head->stack);
217: #endif
219: /*
220: Allow logging of all mallocs made
221: */
222: if (PetscLogMalloc > -1 && PetscLogMalloc < PetscLogMallocMax) {
223: if (!PetscLogMalloc) {
224: PetscLogMallocLength = (size_t*)malloc(PetscLogMallocMax*sizeof(size_t));
225: if (!PetscLogMallocLength) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM," ");
226: PetscLogMallocDirectory = (const char**)malloc(PetscLogMallocMax*sizeof(char**));
227: if (!PetscLogMallocDirectory) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM," ");
228: PetscLogMallocFile = (const char**)malloc(PetscLogMallocMax*sizeof(char**));
229: if (!PetscLogMallocFile) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM," ");
230: PetscLogMallocFunction = (const char**)malloc(PetscLogMallocMax*sizeof(char**));
231: if (!PetscLogMallocFunction) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM," ");
232: }
233: PetscLogMallocLength[PetscLogMalloc] = nsize;
234: PetscLogMallocDirectory[PetscLogMalloc] = dir;
235: PetscLogMallocFile[PetscLogMalloc] = filename;
236: PetscLogMallocFunction[PetscLogMalloc++] = function;
237: }
238: *result = (void*)inew;
239: return(0);
240: }
245: /*
246: PetscTrFreeDefault - Free with tracing.
248: Input Parameters:
249: . a - pointer to a block allocated with PetscTrMalloc
250: . lineno - line number where used. Use __LINE__ for this
251: . function - function calling routine. Use __FUNCT__ for this
252: . file - file name where used. Use __FILE__ for this
253: . dir - directory where file is. Use __SDIR__ for this
254: */
255: PetscErrorCode PetscTrFreeDefault(void *aa,int line,const char function[],const char file[],const char dir[])
256: {
257: char *a = (char*)aa;
258: TRSPACE *head;
259: char *ahead;
261: PetscClassId *nend;
262:
264: /* Do not try to handle empty blocks */
265: if (!a) {
266: (*PetscErrorPrintf)("PetscTrFreeDefault called from %s() line %d in %s%s\n",function,line,dir,file);
267: SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Trying to free null block: Free called from %s() line %d in %s%s\n",function,line,dir,file);
268: }
269:
270: if (TRdebugLevel) {
271: PetscMallocValidate(line,function,file,dir);
272: }
273:
274: ahead = a;
275: a = a - sizeof(TrSPACE);
276: head = (TRSPACE *)a;
277:
278: if (head->classid != CLASSID_VALUE) {
279: (*PetscErrorPrintf)("PetscTrFreeDefault() called from %s() line %d in %s%s\n",function,line,dir,file);
280: (*PetscErrorPrintf)("Block at address %p is corrupted; cannot free;\nmay be block not allocated with PetscMalloc()\n",a);
281: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC,"Bad location or corrupted memory");
282: }
283: nend = (PetscClassId *)(ahead + head->size);
284: if (*nend != CLASSID_VALUE) {
285: if (*nend == ALREADY_FREED) {
286: (*PetscErrorPrintf)("PetscTrFreeDefault() called from %s() line %d in %s%s\n",function,line,dir,file);
287: (*PetscErrorPrintf)("Block [id=%d(%.0f)] at address %p was already freed\n",head->id,(PetscLogDouble)head->size,a + sizeof(TrSPACE));
288: if (head->lineno > 0 && head->lineno < 50000 /* sanity check */) {
289: (*PetscErrorPrintf)("Block freed in %s() line %d in %s%s\n",head->functionname,head->lineno,head->dirname,head->filename);
290: } else {
291: (*PetscErrorPrintf)("Block allocated in %s() line %d in %s%s\n",head->functionname,-head->lineno,head->dirname,head->filename);
292: }
293: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Memory already freed");
294: } else {
295: /* Damaged tail */
296: (*PetscErrorPrintf)("PetscTrFreeDefault() called from %s() line %d in %s%s\n",function,line,dir,file);
297: (*PetscErrorPrintf)("Block [id=%d(%.0f)] at address %p is corrupted (probably write past end of array)\n",head->id,(PetscLogDouble)head->size,a);
298: (*PetscErrorPrintf)("Block allocated in %s() line %d in %s%s\n",head->functionname,head->lineno,head->dirname,head->filename);
299: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC,"Corrupted memory");
300: }
301: }
302: /* Mark the location freed */
303: *nend = ALREADY_FREED;
304: /* Save location where freed. If we suspect the line number, mark as allocated location */
305: if (line > 0 && line < 50000) {
306: head->lineno = line;
307: head->filename = file;
308: head->functionname = function;
309: head->dirname = dir;
310: } else {
311: head->lineno = - head->lineno;
312: }
313: /* zero out memory - helps to find some reuse of already freed memory */
314: PetscMemzero(aa,head->size);
315:
316: TRallocated -= head->size;
317: TRfrags --;
318: if (head->prev) head->prev->next = head->next;
319: else TRhead = head->next;
320:
321: if (head->next) head->next->prev = head->prev;
322: PetscFreeAlign(a,line,function,file,dir);
323: return(0);
324: }
329: /*@C
330: PetscMemoryShowUsage - Shows the amount of memory currently being used
331: in a communicator.
332:
333: Collective on PetscViewer
335: Input Parameter:
336: + viewer - the viewer that defines the communicator
337: - message - string printed before values
339: Level: intermediate
341: Concepts: memory usage
343: .seealso: PetscMallocDump(), PetscMemoryGetCurrentUsage()
344: @*/
345: PetscErrorCode PetscMemoryShowUsage(PetscViewer viewer,const char message[])
346: {
347: PetscLogDouble allocated,maximum,resident,residentmax;
349: PetscMPIInt rank;
350: MPI_Comm comm;
353: if (!viewer) viewer = PETSC_VIEWER_STDOUT_WORLD;
354: PetscMallocGetCurrentUsage(&allocated);
355: PetscMallocGetMaximumUsage(&maximum);
356: PetscMemoryGetCurrentUsage(&resident);
357: PetscMemoryGetMaximumUsage(&residentmax);
358: if (residentmax > 0) residentmax = PetscMax(resident,residentmax);
359: PetscObjectGetComm((PetscObject)viewer,&comm);
360: MPI_Comm_rank(comm,&rank);
361: PetscViewerASCIIPrintf(viewer,message);
362: PetscViewerASCIISynchronizedAllow(viewer,PETSC_TRUE);
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: PetscViewerASCIISynchronizedAllow(viewer,PETSC_FALSE);
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: PetscMallocGetDumpLog - Determine whether all calls to PetscMalloc() are being logged
513: Not Collective
515: Output Arguments
516: . logging - PETSC_TRUE if logging is active
518: Options Database Key:
519: . -malloc_log - Activates PetscMallocDumpLog()
521: Level: advanced
523: .seealso: PetscMallocDump(), PetscMallocDumpLog()
524: @*/
525: PetscErrorCode PetscMallocGetDumpLog(PetscBool *logging)
526: {
529: *logging = (PetscBool)(PetscLogMalloc >= 0);
530: return(0);
531: }
535: /*@C
536: PetscMallocDumpLog - Dumps the log of all calls to PetscMalloc(); also calls
537: PetscMemoryGetMaximumUsage()
539: Collective on PETSC_COMM_WORLD
541: Input Parameter:
542: . fp - file pointer; or PETSC_NULL
544: Options Database Key:
545: . -malloc_log - Activates PetscMallocDumpLog()
547: Level: advanced
549: Fortran Note:
550: The calling sequence in Fortran is PetscMallocDumpLog(integer ierr)
551: The fp defaults to stdout.
553: .seealso: PetscMallocGetCurrentUsage(), PetscMallocDump(), PetscMallocSetDumpLog()
554: @*/
555: PetscErrorCode PetscMallocDumpLog(FILE *fp)
556: {
557: PetscInt i,j,n,dummy,*perm;
558: size_t *shortlength;
559: int *shortcount,err;
560: PetscMPIInt rank,size,tag = 1212 /* very bad programming */;
561: PetscBool match;
562: const char **shortfunction;
563: PetscLogDouble rss;
564: MPI_Status status;
568: MPI_Comm_rank(MPI_COMM_WORLD,&rank);
569: MPI_Comm_size(MPI_COMM_WORLD,&size);
570: /*
571: Try to get the data printed in order by processor. This will only sometimes work
572: */
573: err = fflush(fp);
574: if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");
576: MPI_Barrier(MPI_COMM_WORLD);
577: if (rank) {
578: MPI_Recv(&dummy,1,MPIU_INT,rank-1,tag,MPI_COMM_WORLD,&status);
579: }
581: if (PetscLogMalloc < 0) SETERRQ(PETSC_COMM_SELF,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()");
583: if (!fp) fp = PETSC_STDOUT;
584: PetscMemoryGetMaximumUsage(&rss);
585: if (rss) {
586: PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Maximum memory PetscMalloc()ed %.0f maximum size of entire process %.0f\n",rank,(PetscLogDouble)TRMaxMem,rss);
587: } else {
588: PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Maximum memory PetscMalloc()ed %.0f OS cannot compute size of entire process\n",rank,(PetscLogDouble)TRMaxMem);
589: }
590: shortcount = (int*)malloc(PetscLogMalloc*sizeof(int));if (!shortcount) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Out of memory");
591: shortlength = (size_t*)malloc(PetscLogMalloc*sizeof(size_t));if (!shortlength) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Out of memory");
592: shortfunction = (const char**)malloc(PetscLogMalloc*sizeof(char *));if (!shortfunction) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Out of memory");
593: shortfunction[0] = PetscLogMallocFunction[0];
594: shortlength[0] = PetscLogMallocLength[0];
595: shortcount[0] = 0;
596: n = 1;
597: for (i=1; i<PetscLogMalloc; i++) {
598: for (j=0; j<n; j++) {
599: PetscStrcmp(shortfunction[j],PetscLogMallocFunction[i],&match);
600: if (match) {
601: shortlength[j] += PetscLogMallocLength[i];
602: shortcount[j]++;
603: goto foundit;
604: }
605: }
606: shortfunction[n] = PetscLogMallocFunction[i];
607: shortlength[n] = PetscLogMallocLength[i];
608: shortcount[n] = 1;
609: n++;
610: foundit:;
611: }
613: perm = (PetscInt*)malloc(n*sizeof(PetscInt));if (!perm) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Out of memory");
614: for (i=0; i<n; i++) perm[i] = i;
615: PetscSortStrWithPermutation(n,(const char **)shortfunction,perm);
617: PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Memory usage sorted by function\n",rank);
618: for (i=0; i<n; i++) {
619: PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] %d %.0f %s()\n",rank,shortcount[perm[i]],(PetscLogDouble)shortlength[perm[i]],shortfunction[perm[i]]);
620: }
621: free(perm);
622: free(shortlength);
623: free(shortcount);
624: free((char **)shortfunction);
625: err = fflush(fp);
626: if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");
627: if (rank != size-1) {
628: MPI_Send(&dummy,1,MPIU_INT,rank+1,tag,MPI_COMM_WORLD);
629: }
630: return(0);
631: }
633: /* ---------------------------------------------------------------------------- */
637: /*@C
638: PetscMallocDebug - Turns on/off debugging for the memory management routines.
640: Not Collective
642: Input Parameter:
643: . level - PETSC_TRUE or PETSC_FALSE
645: Level: intermediate
647: .seealso: CHKMEMQ(), PetscMallocValidate()
648: @*/
649: PetscErrorCode PetscMallocDebug(PetscBool level)
650: {
652: TRdebugLevel = level;
653: return(0);
654: }