Actual source code: mprint.c

petsc-3.4.4 2014-03-13
  1: /*
  2:       Utilites routines to add simple ASCII IO capability.
  3: */
  4: #include <../src/sys/fileio/mprint.h>
  5: #include <errno.h>
  6: /*
  7:    If petsc_history is on, then all Petsc*Printf() results are saved
  8:    if the appropriate (usually .petschistory) file.
  9: */
 10: extern FILE *petsc_history;
 11: /*
 12:      Allows one to overwrite where standard out is sent. For example
 13:      PETSC_STDOUT = fopen("/dev/ttyXX","w") will cause all standard out
 14:      writes to go to terminal XX; assuming you have write permission there
 15: */
 16: FILE *PETSC_STDOUT = 0;
 17: /*
 18:      Allows one to overwrite where standard error is sent. For example
 19:      PETSC_STDERR = fopen("/dev/ttyXX","w") will cause all standard error
 20:      writes to go to terminal XX; assuming you have write permission there
 21: */
 22: FILE *PETSC_STDERR = 0;

 24: /*
 25:      Return the maximum expected new size of the format
 26: */
 27: #define PETSC_MAX_LENGTH_FORMAT(l) (l+l/8)

 31: /*@C
 32:      PetscFormatConvert - Takes a PETSc format string and converts it to a reqular C format string

 34:    Input Parameters:
 35: +   format - the PETSc format string
 36: .   newformat - the location to put the standard C format string values
 37: -   size - the length of newformat

 39:     Note: this exists so we can have the same code when PetscInt is either int or long long and PetscScalar is either __float128, double, or float

 41:  Level: developer

 43: @*/
 44: PetscErrorCode  PetscFormatConvert(const char *format,char *newformat,size_t size)
 45: {
 46:   PetscInt i = 0,j = 0;

 49:   while (format[i] && j < (PetscInt)size-1) {
 50:     if (format[i] == '%' && format[i+1] != '%') {
 51:       /* Find the letter */
 52:       for (; format[i] && format[i] <= '9'; i++) newformat[j++] = format[i];
 53:       switch (format[i]) {
 54:       case 'D':
 55: #if !defined(PETSC_USE_64BIT_INDICES)
 56:         newformat[j++] = 'd';
 57: #else
 58:         newformat[j++] = 'l';
 59:         newformat[j++] = 'l';
 60:         newformat[j++] = 'd';
 61: #endif
 62:         break;
 63:       case 'G':
 64: #if defined(PETSC_USE_REAL_DOUBLE) || defined(PETSC_USE_REAL_SINGLE)
 65:         newformat[j++] = 'g';
 66: #elif defined(PETSC_USE_REAL___FLOAT128)
 67:         newformat[j++] = 'Q';
 68:         newformat[j++] = 'g';
 69: #endif
 70:         break;
 71:       case 'F':
 72: #if defined(PETSC_USE_REAL_DOUBLE) || defined(PETSC_USE_REAL_SINGLE)
 73:         newformat[j++] = 'f';
 74: #elif defined(PETSC_USE_REAL_LONG_DOUBLE)
 75:         newformat[j++] = 'L';
 76:         newformat[j++] = 'f';
 77: #elif defined(PETSC_USE_REAL___FLOAT128)
 78:         newformat[j++] = 'Q';
 79:         newformat[j++] = 'f';
 80: #endif
 81:         break;
 82:       default:
 83:         newformat[j++] = format[i];
 84:         break;
 85:       }
 86:       i++;
 87:     } else newformat[j++] = format[i++];
 88:   }
 89:   newformat[j] = 0;
 90:   return(0);
 91: }

 95: /*@C
 96:      PetscVSNPrintf - The PETSc version of vsnprintf(). Converts a PETSc format string into a standard C format string and then puts all the
 97:        function arguments into a string using the format statement.

 99:    Input Parameters:
100: +   str - location to put result
101: .   len - the amount of space in str
102: +   format - the PETSc format string
103: -   fullLength - the amount of space in str actually used.

105:     Developer Notes: this function may be called from an error handler, if an error occurs when it is called by the error handler than likely
106:       a recursion will occur and possible crash.

108:  Level: developer

110: @*/
111: PetscErrorCode  PetscVSNPrintf(char *str,size_t len,const char *format,size_t *fullLength,va_list Argp)
112: {
113:   char           *newformat;
114:   char           formatbuf[8*1024];
115:   size_t         oldLength,length;
116:   int            fullLengthInt;

120:   PetscStrlen(format, &oldLength);
121:   if (oldLength < 8*1024) {
122:     newformat = formatbuf;
123:     oldLength = 8*1024-1;
124:   } else {
125:     oldLength = PETSC_MAX_LENGTH_FORMAT(oldLength);
126:     PetscMalloc(oldLength * sizeof(char), &newformat);
127:   }
128:   PetscFormatConvert(format,newformat,oldLength);
129:   PetscStrlen(newformat, &length);
130: #if 0
131:   if (length > len) newformat[len] = '\0';
132: #endif
133: #if defined(PETSC_HAVE_VSNPRINTF_CHAR)
134:   fullLengthInt = vsnprintf(str,len,newformat,(char*)Argp);
135: #elif defined(PETSC_HAVE_VSNPRINTF)
136:   fullLengthInt = vsnprintf(str,len,newformat,Argp);
137: #elif defined(PETSC_HAVE__VSNPRINTF)
138:   fullLengthInt = _vsnprintf(str,len,newformat,Argp);
139: #else
140: #error "vsnprintf not found"
141: #endif
142:   if (fullLengthInt < 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"vsnprintf() failed");
143:   if (fullLength) *fullLength = (size_t)fullLengthInt;
144:   if (oldLength >= 8*1024) {
145:     PetscFree(newformat);
146:   }
147:   return(0);
148: }

152: /*@C
153:      PetscVFPrintf -  All PETSc standard out and error messages are sent through this function; so, in theory, this can
154:         can be replaced with something that does not simply write to a file.

156:       To use, write your own function for example,
157: $PetscErrorCode mypetscvfprintf(FILE *fd,const char format[],va_list Argp)
158: ${
160: $
162: $   if (fd != stdout && fd != stderr) {  handle regular files
163: $      PetscVFPrintfDefault(fd,format,Argp);CHKERR(ierr);
164: $  } else {
165: $     char   buff[BIG];
166: $     size_t length;
167: $     PetscVSNPrintf(buff,BIG,format,&length,Argp);
168: $     now send buff to whatever stream or whatever you want
169: $ }
170: $ return(0);
171: $}
172: then before the call to PetscInitialize() do the assignment
173: $    PetscVFPrintf = mypetscvfprintf;

175:       Notes: For error messages this may be called by any process, for regular standard out it is
176:           called only by process 0 of a given communicator

178:       Developer Notes: this could be called by an error handler, if that happens then a recursion of the error handler may occur
179:                        and a crash

181:   Level:  developer

183: .seealso: PetscVSNPrintf(), PetscErrorPrintf()

185: @*/
186: PetscErrorCode  PetscVFPrintfDefault(FILE *fd,const char *format,va_list Argp)
187: {
188:   char           *newformat;
189:   char           formatbuf[8*1024];
190:   size_t         oldLength;

194:   PetscStrlen(format, &oldLength);
195:   if (oldLength < 8*1024) {
196:     newformat = formatbuf;
197:     oldLength = 8*1024-1;
198:   } else {
199:     oldLength = PETSC_MAX_LENGTH_FORMAT(oldLength);
200:     PetscMalloc(oldLength * sizeof(char), &newformat);
201:   }
202:   PetscFormatConvert(format,newformat,oldLength);

204: #if defined(PETSC_HAVE_VFPRINTF_CHAR)
205:   vfprintf(fd,newformat,(char*)Argp);
206: #else
207:   vfprintf(fd,newformat,Argp);
208: #endif
209:   fflush(fd);
210:   if (oldLength >= 8*1024) {
211:     PetscFree(newformat);
212:   }
213:   return(0);
214: }

218: /*@C
219:     PetscSNPrintf - Prints to a string of given length

221:     Not Collective

223:     Input Parameters:
224: +   str - the string to print to
225: .   len - the length of str
226: .   format - the usual printf() format string
227: -   any arguments

229:    Level: intermediate

231: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), PetscVSNPrintf(),
232:           PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf()
233: @*/
234: PetscErrorCode  PetscSNPrintf(char *str,size_t len,const char format[],...)
235: {
237:   size_t         fullLength;
238:   va_list        Argp;

241:   va_start(Argp,format);
242:   PetscVSNPrintf(str,len,format,&fullLength,Argp);
243:   return(0);
244: }

248: /*@C
249:     PetscSNPrintfCount - Prints to a string of given length, returns count

251:     Not Collective

253:     Input Parameters:
254: +   str - the string to print to
255: .   len - the length of str
256: .   format - the usual printf() format string
257: .   countused - number of characters used
258: -   any arguments

260:    Level: intermediate

262: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), PetscVSNPrintf(),
263:           PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf(), PetscSNPrintf()
264: @*/
265: PetscErrorCode  PetscSNPrintfCount(char *str,size_t len,const char format[],size_t *countused,...)
266: {
268:   va_list        Argp;

271:   va_start(Argp,countused);
272:   PetscVSNPrintf(str,len,format,countused,Argp);
273:   return(0);
274: }

276: /* ----------------------------------------------------------------------- */

278: PrintfQueue petsc_printfqueue       = 0,petsc_printfqueuebase = 0;
279: int         petsc_printfqueuelength = 0;
280: FILE        *petsc_printfqueuefile  = NULL;

284: /*@C
285:     PetscSynchronizedPrintf - Prints synchronized output from several processors.
286:     Output of the first processor is followed by that of the second, etc.

288:     Not Collective

290:     Input Parameters:
291: +   comm - the communicator
292: -   format - the usual printf() format string

294:    Level: intermediate

296:     Notes:
297:     REQUIRES a intervening call to PetscSynchronizedFlush() for the information
298:     from all the processors to be printed.

300:     Fortran Note:
301:     The call sequence is PetscSynchronizedPrintf(MPI_Comm, character(*), PetscErrorCode ierr) from Fortran.
302:     That is, you can only pass a single character string from Fortran.

304: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(),
305:           PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf()
306: @*/
307: PetscErrorCode  PetscSynchronizedPrintf(MPI_Comm comm,const char format[],...)
308: {
310:   PetscMPIInt    rank;

313:   if (comm == MPI_COMM_NULL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Called with MPI_COMM_NULL, likely PetscObjectComm() failed");
314:   MPI_Comm_rank(comm,&rank);

316:   /* First processor prints immediately to stdout */
317:   if (!rank) {
318:     va_list Argp;
319:     va_start(Argp,format);
320:     (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);
321:     if (petsc_history) {
322:       va_start(Argp,format);
323:       (*PetscVFPrintf)(petsc_history,format,Argp);
324:     }
325:     va_end(Argp);
326:   } else { /* other processors add to local queue */
327:     va_list     Argp;
328:     PrintfQueue next;
329:     size_t      fullLength = 8191;

331:     PetscNew(struct _PrintfQueue,&next);
332:     if (petsc_printfqueue) {
333:       petsc_printfqueue->next = next;
334:       petsc_printfqueue       = next;
335:       petsc_printfqueue->next = 0;
336:     } else petsc_printfqueuebase = petsc_printfqueue = next;
337:     petsc_printfqueuelength++;
338:     next->size = -1;
339:     while ((PetscInt)fullLength >= next->size) {
340:       next->size = fullLength+1;

342:       PetscMalloc(next->size * sizeof(char), &next->string);
343:       va_start(Argp,format);
344:       PetscMemzero(next->string,next->size);
345:       PetscVSNPrintf(next->string,next->size,format, &fullLength,Argp);
346:       va_end(Argp);
347:     }
348:   }
349:   return(0);
350: }

354: /*@C
355:     PetscSynchronizedFPrintf - Prints synchronized output to the specified file from
356:     several processors.  Output of the first processor is followed by that of the
357:     second, etc.

359:     Not Collective

361:     Input Parameters:
362: +   comm - the communicator
363: .   fd - the file pointer
364: -   format - the usual printf() format string

366:     Level: intermediate

368:     Notes:
369:     REQUIRES a intervening call to PetscSynchronizedFlush() for the information
370:     from all the processors to be printed.

372: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(), PetscFPrintf(),
373:           PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()

375: @*/
376: PetscErrorCode  PetscSynchronizedFPrintf(MPI_Comm comm,FILE *fp,const char format[],...)
377: {
379:   PetscMPIInt    rank;

382:   if (comm == MPI_COMM_NULL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Called with MPI_COMM_NULL, likely PetscObjectComm() failed");
383:   MPI_Comm_rank(comm,&rank);

385:   /* First processor prints immediately to fp */
386:   if (!rank) {
387:     va_list Argp;
388:     va_start(Argp,format);
389:     (*PetscVFPrintf)(fp,format,Argp);

391:     petsc_printfqueuefile = fp;
392:     if (petsc_history && (fp !=petsc_history)) {
393:       va_start(Argp,format);
394:       (*PetscVFPrintf)(petsc_history,format,Argp);
395:     }
396:     va_end(Argp);
397:   } else { /* other processors add to local queue */
398:     va_list     Argp;
399:     PrintfQueue next;
400:     size_t      fullLength = 8191;
401:     PetscNew(struct _PrintfQueue,&next);
402:     if (petsc_printfqueue) {
403:       petsc_printfqueue->next = next;
404:       petsc_printfqueue       = next;
405:       petsc_printfqueue->next = 0;
406:     } else petsc_printfqueuebase = petsc_printfqueue = next;
407:     petsc_printfqueuelength++;
408:     next->size = -1;
409:     while ((PetscInt)fullLength >= next->size) {
410:       next->size = fullLength+1;
411:       PetscMalloc(next->size * sizeof(char), &next->string);
412:       va_start(Argp,format);
413:       PetscMemzero(next->string,next->size);
414:       PetscVSNPrintf(next->string,next->size,format,&fullLength,Argp);
415:       va_end(Argp);
416:     }
417:   }
418:   return(0);
419: }

423: /*@
424:     PetscSynchronizedFlush - Flushes to the screen output from all processors
425:     involved in previous PetscSynchronizedPrintf() calls.

427:     Collective on MPI_Comm

429:     Input Parameters:
430: .   comm - the communicator

432:     Level: intermediate

434:     Notes:
435:     Usage of PetscSynchronizedPrintf() and PetscSynchronizedFPrintf() with
436:     different MPI communicators REQUIRES an intervening call to PetscSynchronizedFlush().

438: .seealso: PetscSynchronizedPrintf(), PetscFPrintf(), PetscPrintf(), PetscViewerASCIIPrintf(),
439:           PetscViewerASCIISynchronizedPrintf()
440: @*/
441: PetscErrorCode  PetscSynchronizedFlush(MPI_Comm comm)
442: {
444:   PetscMPIInt    rank,size,tag,i,j,n = 0,dummy = 0;
445:   char          *message;
446:   MPI_Status     status;
447:   FILE           *fd;

450:   PetscCommDuplicate(comm,&comm,&tag);
451:   MPI_Comm_rank(comm,&rank);
452:   MPI_Comm_size(comm,&size);

454:   /* First processor waits for messages from all other processors */
455:   if (!rank) {
456:     if (petsc_printfqueuefile) fd = petsc_printfqueuefile;
457:     else fd = PETSC_STDOUT;
458:     for (i=1; i<size; i++) {
459:       /* to prevent a flood of messages to process zero, request each message separately */
460:       MPI_Send(&dummy,1,MPI_INT,i,tag,comm);
461:       MPI_Recv(&n,1,MPI_INT,i,tag,comm,&status);
462:       for (j=0; j<n; j++) {
463:         PetscMPIInt size = 0;

465:         MPI_Recv(&size,1,MPI_INT,i,tag,comm,&status);
466:         PetscMalloc(size * sizeof(char), &message);
467:         MPI_Recv(message,size,MPI_CHAR,i,tag,comm,&status);
468:         PetscFPrintf(comm,fd,"%s",message);
469:         PetscFree(message);
470:       }
471:     }
472:     petsc_printfqueuefile = NULL;
473:   } else { /* other processors send queue to processor 0 */
474:     PrintfQueue next = petsc_printfqueuebase,previous;

476:     MPI_Recv(&dummy,1,MPI_INT,0,tag,comm,&status);
477:     MPI_Send(&petsc_printfqueuelength,1,MPI_INT,0,tag,comm);
478:     for (i=0; i<petsc_printfqueuelength; i++) {
479:       MPI_Send(&next->size,1,MPI_INT,0,tag,comm);
480:       MPI_Send(next->string,next->size,MPI_CHAR,0,tag,comm);
481:       previous = next;
482:       next     = next->next;
483:       PetscFree(previous->string);
484:       PetscFree(previous);
485:     }
486:     petsc_printfqueue       = 0;
487:     petsc_printfqueuelength = 0;
488:   }
489:   PetscCommDestroy(&comm);
490:   return(0);
491: }

493: /* ---------------------------------------------------------------------------------------*/

497: /*@C
498:     PetscFPrintf - Prints to a file, only from the first
499:     processor in the communicator.

501:     Not Collective

503:     Input Parameters:
504: +   comm - the communicator
505: .   fd - the file pointer
506: -   format - the usual printf() format string

508:     Level: intermediate

510:     Fortran Note:
511:     This routine is not supported in Fortran.

513:    Concepts: printing^in parallel
514:    Concepts: printf^in parallel

516: .seealso: PetscPrintf(), PetscSynchronizedPrintf(), PetscViewerASCIIPrintf(),
517:           PetscViewerASCIISynchronizedPrintf(), PetscSynchronizedFlush()
518: @*/
519: PetscErrorCode  PetscFPrintf(MPI_Comm comm,FILE* fd,const char format[],...)
520: {
522:   PetscMPIInt    rank;

525:   if (comm == MPI_COMM_NULL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Called with MPI_COMM_NULL, likely PetscObjectComm() failed");
526:   MPI_Comm_rank(comm,&rank);
527:   if (!rank) {
528:     va_list Argp;
529:     va_start(Argp,format);
530:     (*PetscVFPrintf)(fd,format,Argp);
531:     if (petsc_history && (fd !=petsc_history)) {
532:       va_start(Argp,format);
533:       (*PetscVFPrintf)(petsc_history,format,Argp);
534:     }
535:     va_end(Argp);
536:   }
537:   return(0);
538: }

542: /*@C
543:     PetscPrintf - Prints to standard out, only from the first
544:     processor in the communicator. Calls from other processes are ignored.

546:     Not Collective

548:     Input Parameters:
549: +   comm - the communicator
550: -   format - the usual printf() format string

552:    Level: intermediate

554:     Fortran Note:
555:     The call sequence is PetscPrintf(MPI_Comm, character(*), PetscErrorCode ierr) from Fortran.
556:     That is, you can only pass a single character string from Fortran.

558:    Concepts: printing^in parallel
559:    Concepts: printf^in parallel

561: .seealso: PetscFPrintf(), PetscSynchronizedPrintf()
562: @*/
563: PetscErrorCode  PetscPrintf(MPI_Comm comm,const char format[],...)
564: {
566:   PetscMPIInt    rank;

569:   if (comm == MPI_COMM_NULL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Called with MPI_COMM_NULL, likely PetscObjectComm() failed");
570:   MPI_Comm_rank(comm,&rank);
571:   if (!rank) {
572:     va_list Argp;
573:     va_start(Argp,format);
574:     (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);
575:     if (petsc_history) {
576:       va_start(Argp,format);
577:       (*PetscVFPrintf)(petsc_history,format,Argp);
578:     }
579:     va_end(Argp);
580:   }
581:   return(0);
582: }

584: /* ---------------------------------------------------------------------------------------*/
587: /*@C
588:      PetscHelpPrintf -  All PETSc help messages are passing through this function. You can change how help messages are printed by
589:         replacinng it  with something that does not simply write to a stdout.

591:       To use, write your own function for example,
592: $PetscErrorCode mypetschelpprintf(MPI_Comm comm,const char format[],....)
593: ${
594: $ return(0);
595: $}
596: then before the call to PetscInitialize() do the assignment
597: $    PetscHelpPrintf = mypetschelpprintf;

599:   Note: the default routine used is called PetscHelpPrintfDefault().

601:   Level:  developer

603: .seealso: PetscVSNPrintf(), PetscVFPrintf(), PetscErrorPrintf()
604: @*/
605: PetscErrorCode  PetscHelpPrintfDefault(MPI_Comm comm,const char format[],...)
606: {
608:   PetscMPIInt    rank;

611:   if (comm == MPI_COMM_NULL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Called with MPI_COMM_NULL, likely PetscObjectComm() failed");
612:   MPI_Comm_rank(comm,&rank);
613:   if (!rank) {
614:     va_list Argp;
615:     va_start(Argp,format);
616:     (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);
617:     if (petsc_history) {
618:       va_start(Argp,format);
619:       (*PetscVFPrintf)(petsc_history,format,Argp);
620:     }
621:     va_end(Argp);
622:   }
623:   return(0);
624: }

626: /* ---------------------------------------------------------------------------------------*/


631: /*@C
632:     PetscSynchronizedFGets - Several processors all get the same line from a file.

634:     Collective on MPI_Comm

636:     Input Parameters:
637: +   comm - the communicator
638: .   fd - the file pointer
639: -   len - the length of the output buffer

641:     Output Parameter:
642: .   string - the line read from the file, at end of file string[0] == 0

644:     Level: intermediate

646: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(),
647:           PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()

649: @*/
650: PetscErrorCode  PetscSynchronizedFGets(MPI_Comm comm,FILE *fp,size_t len,char string[])
651: {
653:   PetscMPIInt    rank;

656:   MPI_Comm_rank(comm,&rank);

658:   if (!rank) {
659:     char *ptr = fgets(string, len, fp);

661:     if (!ptr) {
662:       string[0] = 0;
663:       if (!feof(fp)) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_FILE_READ, "Error reading from file: %d", errno);
664:     }
665:   }
666:   MPI_Bcast(string,len,MPI_BYTE,0,comm);
667:   return(0);
668: }

670: #if defined(PETSC_HAVE_MATLAB_ENGINE)
671: #include <mex.h>
674: PetscErrorCode  PetscVFPrintf_Matlab(FILE *fd,const char format[],va_list Argp)
675: {

679:   if (fd != stdout && fd != stderr) { /* handle regular files */
680:     PetscVFPrintfDefault(fd,format,Argp);
681:   } else {
682:     size_t len=8*1024,length;
683:     char   buf[len];

685:     PetscVSNPrintf(buf,len,format,&length,Argp);
686:     mexPrintf("%s",buf);
687:   }
688:   return(0);
689: }
690: #endif

694: /*@C
695:      PetscFormatStrip - Takes a PETSc format string and removes all numerical modifiers to % operations

697:    Input Parameters:
698: .   format - the PETSc format string

700:  Level: developer

702: @*/
703: PetscErrorCode  PetscFormatStrip(char *format)
704: {
705:   size_t loc1 = 0, loc2 = 0;

708:   while (format[loc2]) {
709:     if (format[loc2] == '%') {
710:       format[loc1++] = format[loc2++];
711:       while (format[loc2] && ((format[loc2] >= '0' && format[loc2] <= '9') || format[loc2] == '.')) loc2++;
712:     }
713:     format[loc1++] = format[loc2++];
714:   }
715:   return(0);
716: }