C+ C NAME: C Str2Flt C PURPOSE: C Extract numbers from string and put them in floating point array C CALLING SEQUENCE: subroutine Str2Flt(cStr,nVec,rVec) C INPUTS: C cStr string (e.g. 89/1/12) C nVec integer max # elements read into rVec C OUTPUTS: C nVec integer # elements of rVec filled C If more than nVec numbers were located in the input C string, then nVec is set to the NEGATIVE of the C input value of nVec. C rVec real floating point array with identified numbers C CALLS: C itrim, uppercase, Int2Str, Int2StrSet, Say C SEE ALSO: C Str2Flt_Exp, Str2Flt_XforA, Str2Flt_FforI, Str2Flt_Int C Str2Flt_Mask, Str2Flt_Format, Str2Flt_Crumbs, bStr2Flt C INCLUDE: include 'str2str_inc.h' C PROCEDURE: C > Str2Flt is the main program unit. It checks each character in cStr against C a list of valid characters. Processing characters sequentially going C from first to last, the largest possible substrings representing valid C numbers are extracted. C > If the number of valid numbers in cStr exceeds the requested input C value of nVec, then (output nVec) = -(input nVec). I.e. a negative C return value of nVec indicates that not all numbers have been read C from cStr into the output array rVec. C > By default Str2Flt does not search for exponents (i.e. E and D are C not considered a valid part of a number). If Str2Flt_Exp is called prior C to Str2Flt, then integer exponents will be recognized. The setting C specified by Str2Flt_Exp is only valid for one call to Str2Flt C > Str2Flt builds a format string describing cStr. After the call to C Str2Flt the format string can be extracted using Str2Flt_Format. C > All substrings in cStr that can not be interpreted as part of a C valid number are stored in a string array. The array can be extracted C using Str2Flt_Crumbs. The maximum number of substrings extracted is C currently 20; the max length of each substring also is 20. C Str2Flt_Crumbs also returns the total number of character in cStr C that have not been interpreted as part of a number. C > bStr2Flt is a special case of a Str2Flt call. It will return .TRUE. C if cStr contains exactly nVec numbers with no residual characters C that are not part of any number. (It's used by the ASK routines to C verify whether a valid number has been entered). C MODIFICATION HISTORY: C Written Jan 1989 by DMZ (ARC) C Converted to V2 Dec 1990 by DMZ (ARC) C OCT-1990, Paul Hick (ARC), rewritten and expanded to accept exponentials C DEC-1992, Paul Hick (UCSD/CASS), converted from IDL C SEP-2002, Paul Hick (UCSD/CASS; pphick@ucsd.edu) C Fairly substantial rewrite to remove remaining statement labels. C- character cStr*(*) integer nVec real rVec(nVec) double precision dVec(nVec) integer iVec(nVec) character cSay*7 /'Str2Flt'/ logical bExpIn logical bExpDef /.FALSE./ logical bExp /.FALSE./ logical bXforAIn logical bXforADef /.FALSE./ logical bXforA /.FALSE./ logical bFforIIn logical bFforIDef /.FALSE./ logical bFforI /.FALSE./ logical bIntIn logical bIntDef /.FALSE./ logical bInt /.FALSE./ logical bTrue logical bNotYet logical Str2Flt_CheckNext character ValidNr *10 character ValidNrDot*11 character ValidExp *12 character ValidInt *12 character ValidFull *13 character ValidChar *3 character ValidPM *2 parameter (ValidNr = '1234567890') parameter (ValidChar = '.+-') parameter (ValidPM = '+-') parameter (ValidNrDot = ValidNr//'.') parameter (ValidExp = ValidNr//'+-') parameter (ValidInt = ValidExp) parameter (ValidFull = ValidNr//'.+-') character CH character cFmtChar character cFmtSub*20 character cFmtNew*20 integer Str2Str equivalence (rTmp, iTmp) parameter (nMask = 100) character cMaskIn*(*) character cMask(nMask) /nMask*'1'/ save bExp, bXforA, bFforI, bInt, cMask logical bMask bMask(I) = I .le. nMask .and. cMask(min(I,nMask)) .ne. '1' ! Statement function kSet = Int2StrSet(STR__TRIM) nLen = itrim(cStr) nDim = nVec ! Max. # numbers identified nVec = 0 ! Counter for # numbers actually identified I = 0 ! Position of char being processed iLast = 0 ! End position of last number identified iNumFmt = 0 ! # numbers processed iFmtCnt = 0 ! Counter for sequence of numbers with same format Init = 1 bNotYet = .TRUE. do while (bNotYet) ! Look for next number cFmtChar = ' ' iFirst = 0 ! Start of number not found yet iBlanks = 0 ! Keeps track of blanks preceeding number !------- ! Find the start of a number. bNotYet is used to indicate that the start ! has not yet been found. do while (bNotYet) I = I+1 ! Next character bNotYet = I .le. nLen if (bNotYet) then CH = cStr(I:I) if (bMask(I)) then ! Character is masked iBlanks = 0 else if (CH .eq. ' ') then iBlanks = iBlanks+1 ! Count leading blanks ! First char must be +,- or digit else if (index(ValidFull,CH) .eq. 0) then iBlanks = 0 else ! CH is digit, +, - or dot iDot = 0 !------- ! A + or - must be followed by a dot or digit to be the start of a number if (index(ValidPM,CH) .gt. 0) then bNotYet = Str2Flt_CheckNext(nLen,cStr,nMask,cMask,I,CH,ValidNrDot,iFirst) end if if (bNotYet .and. CH .eq. '.') then ! Check for dot bNotYet = Str2Flt_CheckNext(nLen,cStr,nMask,cMask,I,CH,ValidNr,iFirst) if (iFirst .ne. 0) then iDot = I-1 ! Position of . cFmtChar = 'F' ! Floating point number end if end if ! Digit, or +,- followed by digit if (bNotYet .and. index(ValidNr,CH) .gt. 0) then if (iFirst .eq. 0) iFirst = I end if if (iFirst .eq. 0) iBlanks = 0 iFirst = iFirst-iBlanks ! Include blanks preceeding number in format !------- ! bNotYet = .FALSE. if I = nLen+1 ! So we exit the loop if the end of the string is reached, or when ! the start of a number is found. bNotYet = bNotYet .and. iFirst .eq. 0 end if end if end do !------- ! If the start of a number is found then iFirst specifies the character ! where the number starts. I is the current character. If iFirst > 0 then ! always I <= nLen. If iFirst = 0 then always I = nLen+1. bNotYet = iFirst .gt. 0 if (bNotYet) then !------- ! Characters iLast+1:iFirst-1 are characters which are not part of a number. ! First update the format string for numbers in positions up to iLast ! (which have not yet been added to the format string). Then add a part ! '#X' or 'A#' to the format string for the chars not part of a number. if (iFirst .gt. iLast+1) then call Str2Flt_FmtNumbers(Init,iFmtCnt,cFmtSub,iFmtLen) call Str2Flt_FmtCrumbs(Init,cStr,iFirst,iLast,bXforA) end if !------- ! iFirst is the position where the number starts. ! I is the current position. Now start looking for the end. bTrue = .TRUE. do while (bTrue) I = I+1 ! Number complete ? bNotYet = I .le. nLen .and. .not. bMask(I) bTrue = bNotYet ! Breaks loop if number is complete if (bTrue) then CH = cStr(I:I) if (iDot .eq. 0 .and. CH .eq. '.') then! . is acceptable if it's the first one iDot = I cFmtChar = 'F' else ! only numbers are acceptable bTrue = index(ValidNr,CH) .gt. 0! Valid char for number ? end if end if end do !------ ! If bNotYet=.FALSE. we hit the end of the string, or a masked character ! (this terminates the number). ! If bNotYet=.TRUE. then CH (at pos I) is not a valid char for a number, ! but it might still be the start of an exponent. if (bNotYet) then call uppercase(CH) bNotYet = bExp .and. (CH .eq. 'D' .or. CH .eq. 'E') end if if (bNotYet) then ! Start of exponent found iFmtChar = I ! Position of 'D','E' !------- ! IE is used to find the end of the exponent. Only when we are sure ! that we have a valid exponent will IE be put back into I and will ! we set cFmtChar to 'D' or 'E'. IE = I+1 bNotYet = IE .le. nLen .and. .not. bMask(IE) if (bNotYet) then CH = cStr(IE:IE) bNotYet = index(ValidExp,CH) .gt. 0 ! D/E must be followed by +,- or number if (bNotYet) then if (CH .eq. '+' .or. CH .eq. '-') then IE = IE+1 bNotYet = IE .le. nLen .and. .not. bMask(IE) if (bNotYet) then CH = cStr(IE:IE) ! +,- must be followed by number bNotYet = index(ValidNr,CH) .gt. 0 end if end if if (bNotYet) then !------- ! First number in exponent located (possible preceeded by + or -, ! so we know the exponent is valid. Write IE back to I and set cFmtChar. I = IE cFmtChar = cStr(iFmtChar:iFmtChar) call uppercase(cFmtChar)! 'D' or 'E' do while (bNotYet) I = I+1 bNotYet = I .le. nLen .and. .not. bMask(I) if (bNotYet) then CH = cStr(I:I) ! Only numbers are acceptable in exponent bNotYet = index(ValidNr,CH) .gt. 0 end if end do end if end if end if end if !------ ! Complete number has been identified. At this point bNotYet=.FALSE. ! I is the position after the end of the number. nVec = nVec+1 bNotYet = nVec .le. nDim if (bNotYet) then ! Still room to store number iNumFmt = iNumFmt+1 if (iDot .eq. 0) then ! No dot. It's an integer if (cFmtChar .eq. 'D' .or. cFmtChar .eq. 'E') then iDot = iFmtChar-1 !iDot = I-1 else if (bFforI) then cFmtChar = 'F' iDot = I-1 else cFmtChar = 'I' end if end if !------- ! Set up the format string cFmtNew for the next number to read from string ! (from chars iFirst:I-1). iStr = 0 iStr = iStr+Str2Str(cFmtChar,cFmtNew(iStr+1:)) iStr = iStr+Int2Str(I-iFirst,cFmtNew(iStr+1:)) if (cFmtChar .eq. 'F') then iStr = iStr+Str2Str('.' ,cFmtNew(iStr+1:)) iStr = iStr+Int2Str(I-iDot-1,cFmtNew(iStr+1:)) else if (cFmtChar .eq. 'D' .or. cFmtChar .eq. 'E') then iStr = iStr+Str2Str('.' ,cFmtNew(iStr+1:)) iStr = iStr+Int2Str(max(0,iFmtChar-iDot-1),cFmtNew(iStr+1:)) end if !------- ! Read the number from chars iFirst:I-1 if (cFmtChar .eq. 'I') then ! Read integer read (cStr(iFirst:I-1),'('//cFmtNew(:iStr)//')') iTmp if (bInt) then rVec(nVec) = rTmp else rVec(nVec) = iTmp end if else ! Read floating point read (cStr(iFirst:I-1),'('//cFmtNew(:iStr)//')') rVec(nVec) end if if (iFmtCnt .eq. 0) then ! First number with format cFmtNew cFmtSub = cFmtNew ! Remember format string iFmtCnt = 1 ! First number in sequence iFmtLen = I-iFirst ! # chars in number else if (cFmtNew .eq. cFmtSub) then ! Next number in sequence with format cFmtSub iFmtCnt = iFmtCnt+1 ! Increment counter else ! Sequence with format cFmtSub ended ! Update the format string call Str2Flt_FmtNumbers(Init,iFmtCnt,cFmtSub,iFmtLen) cFmtSub = cFmtNew ! Start a new sequence for format cFmtNew iFmtCnt = 1 ! First number in sequence iFmtLen = I-iFirst ! # chars in number end if I = I-1 iLast = I bNotYet = I .lt. nLen else call Say(cSay,'W','Array','too small to contain all numbers') I = nLen+1 nVec = -nDim end if end if end do !------- ! Cleanup trailing end of string call Str2Flt_FmtNumbers(Init,iFmtCnt,cFmtSub,iFmtLen) if (I .gt. iLast+1) call Str2Flt_FmtCrumbs(Init,cStr,I,iLast,bXforA) kSet = Int2StrSet(kSet) bExp = bExpDef ! Reset defaults bXforA = bXforADef bFforI = bFforIDef bInt = bIntDef do I=1,nMask cMask(I) = '1' end do return C+ C NAME: C Str2Dbl C PURPOSE: C Extract numbers from string and put them in floating point array C CALLING SEQUENCE: entry Str2Dbl(cStr,nVec,dVec) C INPUTS: C cStr string (e.g. 89/1/12) C nVec integer max # elements read into rVec C OUTPUTS: C nVec integer # elements of rVec filled C If more than nVec numbers were located in the input C string, then nVec is set to the NEGATIVE of the C input value of nVec. C rVec real floating point array with identified numbers C PROCEDURE: C Double precision version of Flt2Str C- kSet = Int2StrSet(STR__TRIM) nLen = itrim(cStr) nDim = nVec ! Max. # numbers identified nVec = 0 ! Counter for # numbers actually identified I = 0 ! Position of char being processed iLast = 0 ! End position of last number identified iNumFmt = 0 ! # numbers processed iFmtCnt = 0 ! Counter for sequence of numbers with same format Init = 1 bNotYet = .TRUE. do while (bNotYet) ! Look for next number cFmtChar = ' ' iFirst = 0 ! Start of number not found yet iBlanks = 0 ! Keeps track of blanks preceeding number !------- ! Find the start of a number. bNotYet is used to indicate that the start ! has not yet been found. do while (bNotYet) I = I+1 ! Next character bNotYet = I .le. nLen if (bNotYet) then CH = cStr(I:I) if (bMask(I)) then ! Character is masked iBlanks = 0 else if (CH .eq. ' ') then iBlanks = iBlanks+1 ! Count leading blanks ! First char must be +,- or digit else if (index(ValidFull,CH) .eq. 0) then iBlanks = 0 else ! CH is digit, +, - or dot iDot = 0 !------- ! A + or - must be followed by a dot or digit to be the start of a number if (index(ValidPM,CH) .gt. 0) then bNotYet = Str2Flt_CheckNext(nLen,cStr,nMask,cMask,I,CH,ValidNrDot,iFirst) end if if (bNotYet .and. CH .eq. '.') then ! Check for dot bNotYet = Str2Flt_CheckNext(nLen,cStr,nMask,cMask,I,CH,ValidNr,iFirst) if (iFirst .ne. 0) then iDot = I-1 ! Position of . cFmtChar = 'F' ! Floating point number end if end if ! Digit, or +,- followed by digit if (bNotYet .and. index(ValidNr,CH) .gt. 0) then if (iFirst .eq. 0) iFirst = I end if if (iFirst .eq. 0) iBlanks = 0 iFirst = iFirst-iBlanks ! Include blanks preceeding number in format !------- ! bNotYet = .FALSE. if I = nLen+1 ! So we exit the loop if the end of the string is reached, or when ! the start of a number is found. bNotYet = bNotYet .and. iFirst .eq. 0 end if end if end do !------- ! If the start of a number is found then iFirst specifies the character ! where the number starts. I is the current character. If iFirst > 0 then ! always I <= nLen. If iFirst = 0 then always I = nLen+1. bNotYet = iFirst .gt. 0 if (bNotYet) then !------- ! Characters iLast+1:iFirst-1 are characters which are not part of a number. ! First update the format string for numbers in positions up to iLast ! (which have not yet been added to the format string). Then add a part ! '#X' or 'A#' to the format string for the chars not part of a number. if (iFirst .gt. iLast+1) then call Str2Flt_FmtNumbers(Init,iFmtCnt,cFmtSub,iFmtLen) call Str2Flt_FmtCrumbs(Init,cStr,iFirst,iLast,bXforA) end if !------- ! iFirst is the position where the number starts. ! I is the current position. Now start looking for the end. bTrue = .TRUE. do while (bTrue) I = I+1 ! Number complete ? bNotYet = I .le. nLen .and. .not. bMask(I) bTrue = bNotYet ! Breaks loop if number is complete if (bTrue) then CH = cStr(I:I) if (iDot .eq. 0 .and. CH .eq. '.') then! . is acceptable if it's the first one iDot = I cFmtChar = 'F' else ! only numbers are acceptable bTrue = index(ValidNr,CH) .gt. 0! Valid char for number ? end if end if end do !------ ! If bNotYet=.FALSE. we hit the end of the string, or a masked character ! (this terminates the number). ! If bNotYet=.TRUE. then CH (at pos I) is not a valid char for a number, ! but it might still be the start of an exponent. if (bNotYet) then call uppercase(CH) bNotYet = bExp .and. (CH .eq. 'D' .or. CH .eq. 'E') end if if (bNotYet) then ! Start of exponent found iFmtChar = I ! Position of 'D','E' !------- ! IE is used to find the end of the exponent. Only when we are sure ! that we have a valid exponent will IE be put back into I and will ! we set cFmtChar to 'D' or 'E'. IE = I+1 bNotYet = IE .le. nLen .and. .not. bMask(IE) if (bNotYet) then CH = cStr(IE:IE) bNotYet = index(ValidExp,CH) .gt. 0 ! D/E must be followed by +,- or number if (bNotYet) then if (CH .eq. '+' .or. CH .eq. '-') then IE = IE+1 bNotYet = IE .le. nLen .and. .not. bMask(IE) if (bNotYet) then CH = cStr(IE:IE) ! +,- must be followed by number bNotYet = index(ValidNr,CH) .gt. 0 end if end if if (bNotYet) then !------- ! First number in exponent located (possible preceeded by + or -, ! so we know the exponent is valid. Write IE back to I and set cFmtChar. I = IE cFmtChar = cStr(iFmtChar:iFmtChar) call uppercase(cFmtChar)! 'D' or 'E' do while (bNotYet) I = I+1 bNotYet = I .le. nLen .and. .not. bMask(I) if (bNotYet) then CH = cStr(I:I) ! Only numbers are acceptable in exponent bNotYet = index(ValidNr,CH) .gt. 0 end if end do end if end if end if end if !------ ! Complete number has been identified. At this point bNotYet=.FALSE. ! I is the position after the end of the number. nVec = nVec+1 bNotYet = nVec .le. nDim if (bNotYet) then ! Still room to store number iNumFmt = iNumFmt+1 if (iDot .eq. 0) then ! No dot. It's an integer if (cFmtChar .eq. 'D' .or. cFmtChar .eq. 'E') then iDot = iFmtChar-1 !iDot = I-1 else if (bFforI) then cFmtChar = 'F' iDot = I-1 else cFmtChar = 'I' end if end if !------- ! Set up the format string cFmtNew for the next number to read from string ! (from chars iFirst:I-1). iStr = 0 iStr = iStr+Str2Str(cFmtChar,cFmtNew(iStr+1:)) iStr = iStr+Int2Str(I-iFirst,cFmtNew(iStr+1:)) if (cFmtChar .eq. 'F') then iStr = iStr+Str2Str('.' ,cFmtNew(iStr+1:)) iStr = iStr+Int2Str(I-iDot-1,cFmtNew(iStr+1:)) else if (cFmtChar .eq. 'D' .or. cFmtChar .eq. 'E') then iStr = iStr+Str2Str('.' ,cFmtNew(iStr+1:)) iStr = iStr+Int2Str(max(0,iFmtChar-iDot-1),cFmtNew(iStr+1:)) end if !------- ! Read the number from chars iFirst:I-1 if (cFmtChar .eq. 'I') then ! Read integer read (cStr(iFirst:I-1),'('//cFmtNew(:iStr)//')') iTmp if (bInt) then dVec(nVec) = rTmp else dVec(nVec) = iTmp end if else ! Read floating point read (cStr(iFirst:I-1),'('//cFmtNew(:iStr)//')') dVec(nVec) end if if (iFmtCnt .eq. 0) then ! First number with format cFmtNew cFmtSub = cFmtNew ! Remember format string iFmtCnt = 1 ! First number in sequence iFmtLen = I-iFirst ! # chars in number else if (cFmtNew .eq. cFmtSub) then ! Next number in sequence with format cFmtSub iFmtCnt = iFmtCnt+1 ! Increment counter else ! Sequence with format cFmtSub ended ! Update the format string call Str2Flt_FmtNumbers(Init,iFmtCnt,cFmtSub,iFmtLen) cFmtSub = cFmtNew ! Start a new sequence for format cFmtNew iFmtCnt = 1 ! First number in sequence iFmtLen = I-iFirst ! # chars in number end if I = I-1 iLast = I bNotYet = I .lt. nLen else call Say(cSay,'W','Array','too small to contain all numbers') I = nLen+1 nVec = -nDim end if end if end do !------- ! Cleanup trailing end of string call Str2Flt_FmtNumbers(Init,iFmtCnt,cFmtSub,iFmtLen) if (I .gt. iLast+1) call Str2Flt_FmtCrumbs(Init,cStr,I,iLast,bXforA) kSet = Int2StrSet(kSet) bExp = bExpDef ! Reset defaults bXforA = bXforADef bFforI = bFforIDef bInt = bIntDef do I=1,nMask cMask(I) = '1' end do return C+ C NAME: C Str2Int C PURPOSE: C Extract numbers from string and put them in integer array C CALLING SEQUENCE: entry Str2Int(cStr,nVec,iVec) C INPUTS: C cStr string (e.g. 89/1/12) C nVec integer max # elements read into rVec C OUTPUTS: C nVec integer # elements of rVec filled C If more than nVec numbers were located in the input C string, then nVec is set to the NEGATIVE of the C input value of nVec. C iVec integer integer array with identified numbers C PROCEDURE: C Integer version of Flt2Str C- kSet = Int2StrSet(STR__TRIM) nLen = itrim(cStr) nDim = nVec ! Max. # numbers identified nVec = 0 ! Counter for # numbers actually identified I = 0 ! Position of char being processed iLast = 0 ! End position of last number identified iNumFmt = 0 ! # numbers processed iFmtCnt = 0 ! Counter for sequence of numbers with same format Init = 1 bNotYet = .TRUE. do while (bNotYet) ! Look for next number cFmtChar = ' ' iFirst = 0 ! Start of number not found yet iBlanks = 0 ! Keeps track of blanks preceeding number !------- ! Find the start of a number. bNotYet is used to indicate that the start ! has not yet been found. do while (bNotYet) I = I+1 ! Next character bNotYet = I .le. nLen if (bNotYet) then CH = cStr(I:I) if (bMask(I)) then ! Character is masked iBlanks = 0 else if (CH .eq. ' ') then iBlanks = iBlanks+1 ! Count leading blanks ! First char must be +,- or digit else if (index(ValidInt,CH) .eq. 0) then iBlanks = 0 else ! CH is +,- or digit !------- ! A + or - must be followed by a digit to be the start of a number if (index(ValidPM,CH) .gt. 0) then bNotYet = Str2Flt_CheckNext(nLen,cStr,nMask,cMask,I,CH,ValidNr,iFirst) end if if (bNotYet .and. index(ValidNr,CH) .gt. 0) then if (iFirst .eq. 0) iFirst = I end if if (iFirst .eq. 0) iBlanks = 0 iFirst = iFirst-iBlanks ! Include blanks preceeding number in format !------- ! bNotYet = .FALSE. if I = nLen+1 ! So we exit the loop if the end of the string is reached, or when ! the start of a number is found. bNotYet = bNotYet .and. iFirst .eq. 0 end if end if end do !------- ! If the start of a number is found then iFirst specifies the character ! where the number starts. I is the current character. If iFirst > 0 then ! always I <= nLen. If iFirst = 0 then always I = nLen+1. bNotYet = iFirst .gt. 0 if (bNotYet) then !------- ! Characters iLast+1:iFirst-1 are characters which are not part of a number. ! First update the format string for numbers in positions up to iLast ! (which have not yet been added to the format string). Then add a part ! '#X' or 'A#' to the format string for the chars not part of a number. if (iFirst .gt. iLast+1) then call Str2Flt_FmtNumbers(Init,iFmtCnt,cFmtSub,iFmtLen) call Str2Flt_FmtCrumbs(Init,cStr,iFirst,iLast,bXforA) end if !------- ! iFirst is the position where the number starts. ! I is the current position. Now start looking for the end. do while (bNotYet) I = I+1 ! Number complete ? bNotYet = I .le. nLen .and. .not. bMask(I) if (bNotYet) then CH = cStr(I:I) bNotYet = index(ValidNr,CH) .gt. 0! Valid char for number ? end if end do !------ ! If bNotYet=.FALSE. we hit the end of the string, or a masked character ! (this terminates the number), or CH (at pos I) is not a valid char for a number. !------ ! Complete number has been identified. At this point bNotYet=.FALSE. ! I is the position after the end of the number. nVec = nVec+1 bNotYet = nVec .le. nDim if (bNotYet) then ! Still room to store number iNumFmt = iNumFmt+1 cFmtChar = 'I' !------- ! Set up the format string cFmtNew for the next number to read from string ! (from chars iFirst:I-1). iStr = 0 iStr = iStr+Str2Str(cFmtChar,cFmtNew(iStr+1:)) iStr = iStr+Int2Str(I-iFirst,cFmtNew(iStr+1:)) !------- ! Read the number from chars iFirst:I-1 read (cStr(iFirst:I-1),'('//cFmtNew(:iStr)//')') iVec(nVec) if (iFmtCnt .eq. 0) then ! First number with format cFmtNew cFmtSub = cFmtNew ! Remember format string iFmtCnt = 1 ! First number in sequence iFmtLen = I-iFirst ! # chars in number else if (cFmtNew .eq. cFmtSub) then ! Next number in sequence with format cFmtSub iFmtCnt = iFmtCnt+1 ! Increment counter else ! Sequence with format cFmtSub ended ! Update the format string call Str2Flt_FmtNumbers(Init,iFmtCnt,cFmtSub,iFmtLen) cFmtSub = cFmtNew ! Start a new sequence for format cFmtNew iFmtCnt = 1 ! First number in sequence iFmtLen = I-iFirst ! # chars in number end if I = I-1 iLast = I bNotYet = I .lt. nLen else call Say(cSay,'W','Array','too small to contain all numbers') I = nLen+1 nVec = -nDim end if end if end do !------- ! Cleanup trailing end of string call Str2Flt_FmtNumbers(Init,iFmtCnt,cFmtSub,iFmtLen) if (I .gt. iLast+1) call Str2Flt_FmtCrumbs(Init,cStr,I,iLast,bXforA) kSet = Int2StrSet(kSet) bXforA = bXforADef do I=1,nMask cMask(I) = '1' end do return C+ C NAME: C Str2Flt_Exp C PURPOSE: C Set the value of logical bExp for next call to Str2Flt (def: .FALSE.) C CALLING SEQUENCE: entry Str2Flt_Exp(bExpIn) C INPUTS: C bExpIn logical .FALSE. : ignore 'E' and 'D' C .TRUE. : exponentials of type 'D' and 'E' are interpreted C RESTRICTIONS: C The setting specified by Str2Flt_Exp is only valid for one call to Str2Flt C PROCEDURE: C Entry point in subroutne href=Str2Flt= C C By default Str2Flt does not search for exponents (i.e. E and D are C not considered a valid part of a number). If Str2Flt_Exp is called prior C to Str2Flt, then integer exponents will be recognized. C MODIFICATION HISTORY: C DEC-1992, Paul Hick (UCSD/CASS; pphick@ucsd.edu) C- bExp = bExpIn return C+ C NAME: C Str2Flt_XforA C PURPOSE: C Set the value of bXforA for one call to Str2Flt (def: .FALSE.) C CALLING SEQUENCE: entry Str2Flt_XforA(bXforAIn) C INPUTS: C bXforAIn logical uninterpreted chars are identified with: C .TRUE. : 'X' in cFmt C .FALSE. : 'A' in cFmt C OUTPUTS: C (none) C RESTRICTIONS: C Valid for one call to Str2Flt only; before returning values are set C back to defaults) C PROCEDURE: C Entry point in subroutine href=Str2Flt= C MODIFICATION HISTORY: C DEC-1992, Paul Hick (UCSD/CASS; pphick@ucsd.edu) C- bXforA = bXforAIn return C+ C NAME: C Str2Flt_FforI C PURPOSE: C Determines how integers in the next Str2Flt call are C represented in the format cFmt string: as In or Fn.0 C CALLING SEQUENCE: entry Str2Flt_FforI(bFforIIn) C INPUTS: C bFforIIn logical default: .FALSE. C RESTRICTIONS: C Valid for one call to Str2Flt only. C PROCEDURE: C Entry point in subroutine href=Str2Flt= C C If bFforI=.TRUE. then integers are represented as Fn.0 C in the cFmt string. The default is In. C MODIFICATION HISTORY: C DEC-1992, Paul Hick (UCSD/CASS; pphick@ucsd.edu) C- bFforI = bFforIIn return C+ C NAME: C Str2Flt_Int C PURPOSE: C Deterimines how integers in the next Str2Flt are interpreted. C CALLING SEQUENCE: entry Str2Flt_Int(bIntIn) C INPUTS: C bIntIn logical default: .FALSE. C SEE ALSO: C See href=Str2Flt= C RESTRICTIONS: C Valid for one call to Str2Flt only. C PROCEDURE: C Entry point in subroutine href=Str2Flt= C C If bInt=.TRUE. then integer values are equivalenced C to a real*4. The real*4 value is then returned in the C output array rVec of href=Str2Flt= C MODIFICATION HISTORY: C DEC-1992, Paul Hick (UCSD/CASS; pphick@ucsd.edu) C- bInt = bIntIn return C+ C NAME: C Str2Flt_Mask C CALLING SEQUENCE: entry Str2Flt_Mask(cMaskIn) C PROCEDURE: C Entry point in subroutine href=Str2Flt= C MODIFICATION HISTORY: C DEC-1992, Paul Hick (UCSD/CASS; pphick@ucsd.edu) C- J = len(cMaskIn) if (J .gt. nMask) call Say(cSay,'W','Mask','not completely used') J = min(nMask,J) do I=1,J cMask(I) = cMaskIn(I:I) end do do I=J+1,nMask cMask(I) = '1' end do return end