	SUBROUTINE MOD_FORMAT(FMTIN, FMTOUT, NCHARSOUT)
C+
C 
C FUNCTIONAL DESCRIPTION:	
C 
C    Parse the Fortran format statement in FMTIN and change all I formats after
C    the first 5 to F formats of the same width.  Write the resultant format
C    specification into FMTOUT.
C 
C FORMAL ARGUMENTS:
C  
C     FMTIN:
C	  CHAR	  I	A CHARACTER variable containing the input Fortran
C			format.
C      
C     FMTOUT:
C	  CHAR	  O	A CHARACTER variable which will contain the output
C			Fortran format.  Pass the entire variable in this
C			parameter, not just a substring, since the length will
C			increase. 
C      
C     NCHARSOUT
C	  I*4	  O	An INTEGER*4 variable which will contain, upon return,
C			the number of characters written to FMTOUT.
C      
C INTERFACE:
C
!	INTERFACE
!	  SUBROUTINE MOD_FORMAT(FMTIN, FMTOUT, NCHARSOUT)
!	    CHARACTER(LEN=*), INTENT(IN) :: FMTIN
!	    CHARACTER(LEN=*), INTENT(OUT) :: FMTOUT
!	    INTEGER, INTENT(OUT) :: NCHARSOUT
!	  END SUBROUTINE MOD_FORMAT
!	END INTERFACE
C  
C DESIGN:
C  
C     initialize pointers, counters
C     loop:
C       find next I format; if none left exit loop
C	copy string from FMTIN to FMTOUT up to but not including the I format
C	update input pointer to position of I format
C	keep count of number of I formats
C	if count <= 5 then
C	  copy the I format to FMTOUT
C	  update input, output pointers
C	else
C	  convert Iw to Fw.0 format, write to FMTOUT
C	  update input, output pointers
C	endif
C     endloop
C     copy rest of FMTIN to FMTOUT
C     save number of characeters copied to FMTOUT into NCHARSOUT
C  
C NOTES:
C
C   This routine identifies the Iw format specifier by the single uppercase
C character 'I'.  If the format is entered in lowercase this routine will fail.
C
C   In addition, if the character 'I' is used anywhere else in the format
C statement this routine will fail.
C  
C COMMON BLOCKS:
C  
C     None
C
C INCLUDE FILES:
C
C     None
C 
C This version:    1.0  15-APR-1999
C 
C CREATED: 
C 
C	 3-FEB-1997    Lawrence Bleau
C 
C DEVELOPMENT HISTORY:
C 
C	 Date     | Name  | Description
C ----------------+-------+-----------------------------------------------------
C 15-APR-1999        LRB    added comments
C
C-
CDEC$	IDENT '1.0'
	IMPLICIT NONE
	CHARACTER*(*) FMTIN, FMTOUT
	INTEGER*4 NCHARSOUT
C
	INTEGER NUM_OF_I_FMT, NUM_TO_KEEP/5/, IPTR, OPTR, NCOPY, I, I1, I2, I3
	CHARACTER*500 FMT
C
C Initialize pointers, counters
C
	NUM_OF_I_FMT = 0
	FMT = ' '
	IPTR = 1
	OPTR = 1
D	type *,'input FMTIN='
D	type *,fmtin
C
C Start loop here
C
C Find next I format; if none left exit loop
C
100	I = INDEX (FMTIN(IPTR:), 'I')
	IF (I .EQ. 0) I = 9999
D	IF (I.NE.9999)type *,'found Iw at ',I+IPTR-1
	IF (I .EQ. 9999) GOTO 1000
C
C Copy string from FMTIN to FMT up to but not including the I format
C Update input pointer to position of I format
C
	I2 = IPTR+I-1
	DO WHILE (IPTR .LT. I2)
D	type 101,fmtin(iptr:iptr),iptr,optr
	  FMT(OPTR:OPTR) = FMTIN(IPTR:IPTR)
	  IPTR = IPTR + 1
	  OPTR = OPTR + 1
D101	format(' copying ',a1,' from ',i3,' into ',i3)
	END DO
C
C Keep count of number of I formats
C
	NUM_OF_I_FMT = NUM_OF_I_FMT + 1
D	type 102,num_of_i_fmt
D102	format(' This is the ',i2,'th I format')
C
C If count <= 5 then
C
	IF (NUM_OF_I_FMT .LE. NUM_TO_KEEP) THEN
C
C Keep this I format by just copying it to FMT
C We don't need to parse the rest of this format specifier since the next copy
C operation will take care of that for us.
C Update input, output pointers
C
D	type 101,fmtin(iptr:iptr),iptr,optr
	  FMT(OPTR:OPTR) = FMTIN(IPTR:IPTR)
	  IPTR = IPTR + 1
	  OPTR = OPTR + 1
	ELSE
C
C We've passed NUM_TO_KEEP I formats; start converting them
C Convert Iw to Fw.0 format, write to FMT
C To copy the width part of the specifier copy chars until we reach non-digit
C Update input, output pointers as we go
C
	  FMT(OPTR:OPTR) = 'F'
	  IPTR = IPTR + 1
	  OPTR = OPTR + 1
D	type *,'copying width portion'
	  DO WHILE (INDEX ('0123456789', FMTIN(IPTR:IPTR)) .NE. 0)
D	type 101,fmtin(iptr:iptr),iptr,optr
	    FMT(OPTR:OPTR) = FMTIN(IPTR:IPTR)
	    IPTR = IPTR + 1
	    OPTR = OPTR + 1
	  END DO
C
C Now add a '.0' to output format to make Fw.0
C Update output pointer
C
D	type *,'adding .0 at',optr
	  FMT(OPTR:OPTR+1) = '.0'
	  OPTR = OPTR + 2
C
	ENDIF
D	type *,'loop back'
	GOTO 100
C
C End of loop; there are no more I formats
C
1000	CONTINUE
C
C Copy rest of FMTIN to FMT
C
D	type *,'done loop'
	NCOPY = LEN(FMTIN)-IPTR+1
D	type *,'copying',ncopy,' chars starting at',iptr,' to',optr
	FMT(OPTR:OPTR+NCOPY-1) = FMTIN(IPTR:IPTR+NCOPY-1)
C
C Save number of characeters copied to FMTOUT into NCHARSOUT
C Copy FMT into FMTOUT
C
	NCHARSOUT = MIN(OPTR+NCOPY-1, LEN(FMTOUT))
D	type *,'NCHARSOUT=',ncharsout
	FMTOUT = FMT(1:NCHARSOUT)
	RETURN
	END
